home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-9.10-netbook-remix-PL.iso / casper / filesystem.squashfs / usr / share / perl5 / XML / Twig.pm next >
Text File  |  2009-05-04  |  426KB  |  12,891 lines

  1. # $Id: /xmltwig/trunk/Twig_pm.slow 30 2007-11-13T18:10:03.393214Z mrodrigu  $
  2. #
  3. # Copyright (c) 1999-2004 Michel Rodriguez
  4. # All rights reserved.
  5. #
  6. # This program is free software; you can redistribute it and/or
  7. # modify it under the same terms as Perl itself.
  8. #
  9.  
  10. # This is created in the caller's space
  11. BEGIN
  12. { sub ::PCDATA { '#PCDATA' } 
  13.   sub ::CDATA  { '#CDATA'  } 
  14. }
  15.  
  16. use UNIVERSAL qw(isa);
  17.  
  18. ######################################################################
  19. package XML::Twig;
  20. ######################################################################
  21.  
  22. require 5.004;
  23. use strict;
  24.  
  25. use utf8; # > perl 5.5
  26.  
  27. use vars qw($VERSION @ISA %valid_option);
  28. use Carp;
  29.  
  30. use File::Spec;
  31. use File::Basename;
  32.  
  33. use UNIVERSAL qw(isa);
  34.  
  35. # constants: element types
  36. use constant (PCDATA  => '#PCDATA');
  37. use constant (CDATA   => '#CDATA');
  38. use constant (PI      => '#PI');
  39. use constant (COMMENT => '#COMMENT');
  40. use constant (ENT     => '#ENT');
  41.  
  42. # element classes
  43. use constant (ELT     => '#ELT');
  44. use constant (TEXT    => '#TEXT');
  45.  
  46. # element properties
  47. use constant (ASIS    => '#ASIS');
  48. use constant (EMPTY   => '#EMPTY');
  49.  
  50. # used in parseurl to set the buffer size to the same size as in XML::Parser::Expat
  51. use constant (BUFSIZE => 32768);
  52.  
  53.  
  54. # used to store the gi's
  55. my %gi2index;   # gi => index
  56. my @index2gi;   # list of gi's
  57. my $SPECIAL_GI; # first non-special gi;
  58. my %base_ent;   # base entity character => replacement
  59.  
  60. # flag, set to true if the weaken sub is available
  61. use vars qw( $weakrefs);
  62.  
  63.  
  64.  
  65. # xml name (leading # allowed)
  66. # first line is for perl 5.005, second line for modern perl, that accept character classes
  67. my $REG_NAME       = q{(?:(?:[^\W\d]|[:#])(?:[\w.-]*:)?[\w.-]*)};     # does not work for leading non-ascii letters
  68.    $REG_NAME       = q{(?:(?:[[:alpha:]:#])(?:[\w.-]*:)?[\w.-]*)};    # > perl 5.5
  69.  
  70. # name or wildcard (* or '') (leading # allowed)
  71. my $REG_NAME_W     = q{(?:(?:[^\W\d]|[:#])(?:[\w.-]*:)?[\w.-]*|\*)}; # does not work for leading non-ascii letters
  72.    $REG_NAME_W     = q{(?:(?:[[:alpha:]:#])(?:[\w.-]*:)?[\w.-]*|\*)}; # > perl 5.5
  73.  
  74. my $REG_REGEXP     = q{(?:/(?:[^\\/]|\\.)*/[eimsox]*)};               # regexp
  75. my $REG_REGEXP_EXP = q{(?:(?:[^\\/]|\\.)*)};                          # content of a regexp
  76. my $REG_REGEXP_MOD = q{(?:[eimso]*)};                                 # regexp modifiers
  77. my $REG_MATCH      = q{[!=]~};                                        # match (or not)
  78. my $REG_STRING     = q{(?:"(?:[^\\"]|\\.)*"|'(?:[^\\']|\\.)*')};      # string (simple or double quoted)
  79. my $REG_NUMBER     = q{(?:\d+(?:\.\d*)?|\.\d+)};                      # number
  80. my $REG_VALUE      = qq{(?:$REG_STRING|$REG_NUMBER)};                 # value
  81. my $REG_OP         = q{==|!=|>|<|>=|<=|eq|ne|lt|gt|le|ge|=};          # op
  82. my $REG_FUNCTION   = q{(?:string|text)\(\s*\)};
  83. my $REG_STRING_ARG = qq{(?:string|text)\\(\\s*$REG_NAME_W\\s*\\)};
  84. my $REG_COMP       = q{(?:>=|<=|!=|<|>|=)};
  85.  
  86.  
  87. # used in the handler trigger code
  88. my $REG_NAKED_PREDICATE= qq{((?:"[^"]*"|'[^']*'|$REG_STRING_ARG|$REG_FUNCTION|\@$REG_NAME_W|$REG_MATCH\\s*$REG_REGEXP|[\\s\\d><=!()+.-]|(?i:and)|(?i:or))*)};
  89. my $REG_PREDICATE= qq{\\[$REG_NAKED_PREDICATE\\]};
  90.  
  91. # not all axis, only supported ones (in get_xpath)
  92. my @supported_axis= ( 'ancestor', 'ancestor-or-self', 'child', 'descendant', 'descendant-or-self', 
  93.                       'following', 'following-sibling', 'parent', 'preceding', 'preceding-sibling', 'self'
  94.                     );
  95. my $REG_AXIS       = "(?:" . join( '|', @supported_axis) .")";
  96.  
  97. # only used in the "xpath"engine (for get_xpath/findnodes) for now
  98. my $REG_PREDICATE_ALT  = qr{\[(?:(?:string\(\s*\)|\@$REG_NAME)\s*$REG_MATCH\s*$REG_REGEXP\s*|[^\]]*)\]};
  99.  
  100. # used to convert XPath tests on strings to the perl equivalent 
  101. my %PERL_ALPHA_TEST= ( '=' => ' eq ', '!=' => ' ne ', '>' => ' gt ', '>=' => ' ge ', '<' => ' lt ', '<=' => ' le ');
  102.  
  103. my $parser_version;
  104. my( $FB_HTMLCREF, $FB_XMLCREF);
  105.  
  106. BEGIN
  107. $VERSION = '3.32';
  108.  
  109. use XML::Parser;
  110. my $needVersion = '2.23';
  111. $parser_version= $XML::Parser::VERSION;
  112. croak "need at least XML::Parser version $needVersion" unless $parser_version >= $needVersion;
  113.  
  114. if( $] >= 5.008) 
  115.   { eval "use Encode qw( :all)";
  116.     $FB_XMLCREF  = 0x0400; # Encode::FB_XMLCREF;
  117.     $FB_HTMLCREF = 0x0200; # Encode::FB_HTMLCREF;
  118.   }
  119.  
  120. # test whether we can use weak references
  121. # set local empty signal handler to trap error messages
  122. { local $SIG{__DIE__};
  123.   if( eval( 'require Scalar::Util') && defined( \&Scalar::Util::weaken)) 
  124.     { import Scalar::Util( 'weaken'); $weakrefs= 1; }
  125.   elsif( eval( 'require WeakRef')) 
  126.     { import WeakRef; $weakrefs= 1;                 }
  127.   else  
  128.     { $weakrefs= 0;                                 } 
  129. }
  130.  
  131. import XML::Twig::Elt;
  132. import XML::Twig::Entity;
  133. import XML::Twig::Entity_list;
  134.  
  135. # used to store the gi's
  136. # should be set for each twig really, at least when there are several
  137. # the init ensures that special gi's are always the same
  138.  
  139. # gi => index
  140. # do NOT use => or the constants become quoted!
  141. %XML::Twig::gi2index=( PCDATA, 0, CDATA, 1, PI, 2, COMMENT, 3, ENT, 4); 
  142. # list of gi's
  143. @XML::Twig::index2gi=( PCDATA, CDATA, PI, COMMENT, ENT);
  144.  
  145. # gi's under this value are special 
  146. $XML::Twig::SPECIAL_GI= @XML::Twig::index2gi;
  147.  
  148. %XML::Twig::base_ent= ( '>' => '>', '<' => '<', '&' => '&', "'" => ''', '"' => '"',);
  149.  
  150. # now set some aliases
  151. *find_nodes           = *get_xpath;               # same as XML::XPath
  152. *findnodes            = *get_xpath;               # same as XML::LibXML
  153. *getElementsByTagName = *descendants;
  154. *descendants_or_self  = *descendants;             # valid in XML::Twig, not in XML::Twig::Elt
  155. *find_by_tag_name     = *descendants;
  156. *getElementById       = *elt_id;
  157. *getEltById           = *elt_id;
  158. *toString             = *sprint;
  159. }
  160.  
  161. @ISA = qw(XML::Parser);
  162.  
  163. # fake gi's used in twig_handlers and start_tag_handlers
  164. my $ALL    = '_all_';     # the associated function is always called
  165. my $DEFAULT= '_default_'; # the function is called if no other handler has been
  166.  
  167. # some defaults
  168. my $COMMENTS_DEFAULT= 'keep';
  169. my $PI_DEFAULT      = 'keep';
  170.  
  171.  
  172. # handlers used in regular mode
  173. my %twig_handlers=( Start      => \&_twig_start, 
  174.                     End        => \&_twig_end, 
  175.                     Char       => \&_twig_char, 
  176.                     Entity     => \&_twig_entity, 
  177.                     XMLDecl    => \&_twig_xmldecl, 
  178.                     Doctype    => \&_twig_doctype, 
  179.                     Element    => \&_twig_element, 
  180.                     Attlist    => \&_twig_attlist, 
  181.                     CdataStart => \&_twig_cdatastart, 
  182.                     CdataEnd   => \&_twig_cdataend, 
  183.                     Proc       => \&_twig_pi,
  184.                     Comment    => \&_twig_comment,
  185.                     Default    => \&_twig_default,
  186.                     ExternEnt  => \&_twig_extern_ent,
  187.       );
  188.  
  189. # handlers used when twig_roots is used and we are outside of the roots
  190. my %twig_handlers_roots=
  191.   ( Start      => \&_twig_start_check_roots, 
  192.     End        => \&_twig_end_check_roots, 
  193.     Doctype    => \&_twig_doctype, 
  194.     Char       => undef, Entity     => undef, XMLDecl    => \&_twig_xmldecl, 
  195.     Element    => undef, Attlist    => undef, CdataStart => undef, 
  196.     CdataEnd   => undef, Proc       => undef, Comment    => undef, 
  197.     Proc       => \&_twig_pi_check_roots,
  198.     Default    =>  sub {}, # hack needed for XML::Parser 2.27
  199.     ExternEnt  => \&_twig_extern_ent,
  200.   );
  201.  
  202. # handlers used when twig_roots and print_outside_roots are used and we are
  203. # outside of the roots
  204. my %twig_handlers_roots_print_2_30=
  205.   ( Start      => \&_twig_start_check_roots, 
  206.     End        => \&_twig_end_check_roots, 
  207.     Char       => \&_twig_print, 
  208.     Entity     => \&_twig_print_entity, 
  209.     ExternEnt  => \&_twig_print_entity,
  210.     DoctypeFin => \&_twig_doctype_fin_print,
  211.     XMLDecl    => \&_twig_print,
  212.     Doctype   =>  \&_twig_print_doctype, # because recognized_string is broken here
  213.     # Element    => \&_twig_print, Attlist    => \&_twig_print, 
  214.     CdataStart => \&_twig_print, CdataEnd   => \&_twig_print, 
  215.     Proc       => \&_twig_pi_check_roots, Comment    => \&_twig_print, 
  216.     Default    => \&_twig_print_check_doctype,
  217.     ExternEnt  => \&_twig_extern_ent,
  218.   );
  219.  
  220. # handlers used when twig_roots, print_outside_roots and keep_encoding are used
  221. # and we are outside of the roots
  222. my %twig_handlers_roots_print_original_2_30=
  223.   ( Start      => \&_twig_start_check_roots, 
  224.     End        => \&_twig_end_check_roots, 
  225.     Char       => \&_twig_print_original, 
  226.     # I have no idea why I should not be using this handler!
  227.     Entity     => \&_twig_print_entity, 
  228.     ExternEnt  => \&_twig_print_entity,
  229.     DoctypeFin => \&_twig_doctype_fin_print,
  230.     XMLDecl    => \&_twig_print_original, 
  231.     Doctype    => \&_twig_print_original_doctype,  # because original_string is broken here
  232.     Element    => \&_twig_print_original, Attlist   => \&_twig_print_original,
  233.     CdataStart => \&_twig_print_original, CdataEnd  => \&_twig_print_original,
  234.     Proc       => \&_twig_pi_check_roots, Comment   => \&_twig_print_original,
  235.     Default    => \&_twig_print_original_check_doctype, 
  236.   );
  237.  
  238. # handlers used when twig_roots and print_outside_roots are used and we are
  239. # outside of the roots
  240. my %twig_handlers_roots_print_2_27=
  241.   ( Start      => \&_twig_start_check_roots, 
  242.     End        => \&_twig_end_check_roots, 
  243.     Char       => \&_twig_print, 
  244.     # if the Entity handler is set then it prints the entity declaration
  245.     # before the entire internal subset (including the declaration!) is output
  246.     Entity     => sub {},
  247.     XMLDecl    => \&_twig_print, Doctype    => \&_twig_print, 
  248.     CdataStart => \&_twig_print, CdataEnd   => \&_twig_print, 
  249.     Proc       => \&_twig_pi_check_roots, Comment    => \&_twig_print, 
  250.     Default    => \&_twig_print, 
  251.     ExternEnt  => \&_twig_extern_ent,
  252.   );
  253.  
  254. # handlers used when twig_roots, print_outside_roots and keep_encoding are used
  255. # and we are outside of the roots
  256. my %twig_handlers_roots_print_original_2_27=
  257.   ( Start      => \&_twig_start_check_roots, 
  258.     End        => \&_twig_end_check_roots, 
  259.     Char       => \&_twig_print_original, 
  260.     # for some reason original_string is wrong here 
  261.     # this can be a problem if the doctype includes non ascii characters
  262.     XMLDecl    => \&_twig_print, Doctype    => \&_twig_print,
  263.     # if the Entity handler is set then it prints the entity declaration
  264.     # before the entire internal subset (including the declaration!) is output
  265.     Entity     => sub {}, 
  266.     #Element    => undef, Attlist   => undef,
  267.     CdataStart => \&_twig_print_original, CdataEnd  => \&_twig_print_original,
  268.     Proc       => \&_twig_pi_check_roots, Comment   => \&_twig_print_original,
  269.     Default    => \&_twig_print, #  _twig_print_original does not work
  270.     ExternEnt  => \&_twig_extern_ent,
  271.   );
  272.  
  273.  
  274. my %twig_handlers_roots_print= $parser_version > 2.27 
  275.                                ? %twig_handlers_roots_print_2_30 
  276.                                : %twig_handlers_roots_print_2_27; 
  277. my %twig_handlers_roots_print_original= $parser_version > 2.27 
  278.                                ? %twig_handlers_roots_print_original_2_30 
  279.                                : %twig_handlers_roots_print_original_2_27; 
  280.  
  281.  
  282. # handlers used when the finish_print method has been called
  283. my %twig_handlers_finish_print=
  284.   ( Start      => \&_twig_print, 
  285.     End        => \&_twig_print, Char       => \&_twig_print, 
  286.     Entity     => \&_twig_print, XMLDecl    => \&_twig_print, 
  287.     Doctype    => \&_twig_print, Element    => \&_twig_print, 
  288.     Attlist    => \&_twig_print, CdataStart => \&_twig_print, 
  289.     CdataEnd   => \&_twig_print, Proc       => \&_twig_print, 
  290.     Comment    => \&_twig_print, Default    => \&_twig_print, 
  291.     ExternEnt  => \&_twig_extern_ent,
  292.   );
  293.  
  294. # handlers used when the finish_print method has been called and the keep_encoding
  295. # option is used
  296. my %twig_handlers_finish_print_original=
  297.   ( Start      => \&_twig_print_original, End      => \&_twig_print_end_original, 
  298.     Char       => \&_twig_print_original, Entity   => \&_twig_print_original, 
  299.     XMLDecl    => \&_twig_print_original, Doctype  => \&_twig_print_original, 
  300.     Element    => \&_twig_print_original, Attlist  => \&_twig_print_original, 
  301.     CdataStart => \&_twig_print_original, CdataEnd => \&_twig_print_original, 
  302.     Proc       => \&_twig_print_original, Comment  => \&_twig_print_original, 
  303.     Default    => \&_twig_print_original, 
  304.   );
  305.  
  306. # handlers used within ignored elements
  307. my %twig_handlers_ignore=
  308.   ( Start      => \&_twig_ignore_start, 
  309.     End        => \&_twig_ignore_end, 
  310.     Char       => undef, Entity     => undef, XMLDecl    => undef, 
  311.     Doctype    => undef, Element    => undef, Attlist    => undef, 
  312.     CdataStart => undef, CdataEnd   => undef, Proc       => undef, 
  313.     Comment    => undef, Default    => undef,
  314.     ExternEnt  => undef,
  315.   );
  316.  
  317.  
  318. # those handlers are only used if the entities are NOT to be expanded
  319. my %twig_noexpand_handlers= ( ExternEnt => undef, Default => \&_twig_default );
  320.  
  321. my @saved_default_handler;
  322.  
  323. my $ID= 'id'; # default value, set by the Id argument
  324.  
  325. # all allowed options
  326. %valid_option=
  327.     ( # XML::Twig options
  328.       TwigHandlers          => 1, Id                    => 1,
  329.       TwigRoots             => 1, TwigPrintOutsideRoots => 1,
  330.       StartTagHandlers      => 1, EndTagHandlers        => 1,
  331.       ForceEndTagHandlersUsage => 1,
  332.       DoNotChainHandlers    => 1,
  333.       IgnoreElts            => 1,
  334.       Index                 => 1,
  335.       CharHandler           => 1, 
  336.       TopDownHandlers       => 1,
  337.       KeepEncoding          => 1, DoNotEscapeAmpInAtts  => 1,
  338.       ParseStartTag         => 1, KeepAttsOrder         => 1,
  339.       LoadDTD               => 1, DTDHandler            => 1,
  340.       DoNotOutputDTD        => 1, NoProlog              => 1,
  341.       ExpandExternalEnts    => 1,
  342.       DiscardSpaces         => 1, KeepSpaces            => 1, 
  343.       DiscardSpacesIn       => 1, KeepSpacesIn          => 1, 
  344.       PrettyPrint           => 1, EmptyTags             => 1, 
  345.       Quote                 => 'double',
  346.       Comments              => 1, Pi                    => 1, 
  347.       OutputFilter          => 1, InputFilter           => 1,
  348.       OutputTextFilter      => 1, 
  349.       OutputEncoding        => 1, 
  350.       RemoveCdata           => 1,
  351.       EltClass              => 1,
  352.       MapXmlns              => 1, KeepOriginalPrefix    => 1,
  353.       SkipMissingEnts       => 1,
  354.       # XML::Parser options
  355.       ErrorContext          => 1, ProtocolEncoding      => 1,
  356.       Namespaces            => 1, NoExpand              => 1,
  357.       Stream_Delimiter      => 1, ParseParamEnt         => 1,
  358.       NoLWP                 => 1, Non_Expat_Options     => 1,
  359.       Xmlns                 => 1,
  360.     );
  361.  
  362. # predefined input and output filters
  363. use vars qw( %filter);
  364. %filter= ( html       => \&html_encode,
  365.            safe       => \&safe_encode,
  366.            safe_hex   => \&safe_encode_hex,
  367.          );
  368.  
  369.  
  370. # trigger types (used to sort them)
  371. my ($XPATH_TRIGGER, $REGEXP_TRIGGER, $LEVEL_TRIGGER)=(1..3);
  372.  
  373. sub new
  374.   { my ($class, %args) = @_;
  375.     my $handlers;
  376.  
  377.     # change all nice_perlish_names into nicePerlishNames
  378.     %args= _normalize_args( %args);
  379.  
  380.     # check options
  381.     unless( $args{MoreOptions})
  382.       { foreach my $arg (keys %args)
  383.         { carp "invalid option $arg" unless $valid_option{$arg}; }
  384.       }
  385.      
  386.     # a twig is really an XML::Parser
  387.     # my $self= XML::Parser->new(%args);
  388.     my $self;
  389.     $self= XML::Parser->new(%args);   
  390.  
  391.     bless $self, $class;
  392.  
  393.     $self->{_twig_context_stack}= [];
  394.  
  395.     if( exists $args{TwigHandlers})
  396.       { $handlers= $args{TwigHandlers};
  397.         $self->setTwigHandlers( $handlers);
  398.         delete $args{TwigHandlers};
  399.       }
  400.  
  401.     # take care of twig-specific arguments
  402.     if( exists $args{StartTagHandlers})
  403.       { $self->setStartTagHandlers( $args{StartTagHandlers});
  404.         delete $args{StartTagHandlers};
  405.       }
  406.  
  407.     if( exists $args{DoNotChainHandlers})
  408.       { $self->{twig_do_not_chain_handlers}=  $args{DoNotChainHandlers}; }
  409.  
  410.     if( exists $args{IgnoreElts})
  411.       { # change array to hash so you can write ignore_elts => [ qw(foo bar baz)]
  412.         if( isa( $args{IgnoreElts}, 'ARRAY')) { $args{IgnoreElts}= { map { $_ => 1 } @{$args{IgnoreElts}} }; }
  413.         $self->setIgnoreEltsHandlers( $args{IgnoreElts});
  414.         delete $args{IgnoreElts};
  415.       }
  416.  
  417.     if( exists $args{Index})
  418.       { my $index= $args{Index};
  419.         # we really want a hash name => path, we turn an array into a hash if necessary
  420.         if( ref( $index) eq 'ARRAY')
  421.           { my %index= map { $_ => $_ } @$index;
  422.             $index= \%index;
  423.           }
  424.         while( my( $name, $exp)= each %$index)
  425.           { $self->setTwigHandler( $exp, sub { push @{$_[0]->{_twig_index}->{$name}}, $_; 1; }); }
  426.       }
  427.  
  428.     $self->{twig_elt_class}= $args{EltClass} || 'XML::Twig::Elt';
  429.     if( exists( $args{EltClass})) { delete $args{EltClass}; }
  430.  
  431.     if( exists( $args{MapXmlns}))
  432.       { $self->{twig_map_xmlns}=  $args{MapXmlns};
  433.         $self->{Namespaces}=1;
  434.         delete $args{MapXmlns};
  435.       }
  436.  
  437.     if( exists( $args{KeepOriginalPrefix}))
  438.       { $self->{twig_keep_original_prefix}= $args{KeepOriginalPrefix};
  439.         delete $args{KeepOriginalPrefix};
  440.       }
  441.  
  442.     $self->{twig_dtd_handler}= $args{DTDHandler};
  443.     delete $args{DTDHandler};
  444.  
  445.     if( $args{ExpandExternalEnts})
  446.       { $self->set_expand_external_entities( 1);
  447.         $self->{twig_expand_external_ents}= $args{ExpandExternalEnts}; 
  448.         $self->{twig_read_external_dtd}= 1; # implied by ExpandExternalEnts
  449.         if( $args{ExpandExternalEnts} == -1) 
  450.           { $self->{twig_extern_ent_nofail}= 1;
  451.             $self->setHandlers( ExternEnt => \&_twig_extern_ent_nofail);
  452.           }
  453.         delete $args{LoadDTD};
  454.         delete $args{ExpandExternalEnts};
  455.       }
  456.     else
  457.       { $self->set_expand_external_entities( 0); }
  458.  
  459.     if( !$args{NoLWP} && ! _use( 'URI') && ! _use( 'URI::File') && ! _use( 'LWP'))
  460.       { $self->{twig_ext_ent_handler}= \&XML::Parser::initial_ext_ent_handler }
  461.     else
  462.       { $self->{twig_ext_ent_handler}= \&XML::Parser::file_ext_ent_handler }
  463.  
  464.     if( $args{DoNotEscapeAmpInAtts})
  465.       { $self->set_do_not_escape_amp_in_atts( 1); 
  466.         $self->{twig_do_not_escape_amp_in_atts}=1;
  467.       }
  468.     else
  469.       { $self->set_do_not_escape_amp_in_atts( 0); 
  470.         $self->{twig_do_not_escape_amp_in_atts}=0;
  471.       }
  472.  
  473.     # deal with TwigRoots argument, a hash of elements for which
  474.     # subtrees will be built (and associated handlers)
  475.      
  476.     if( $args{TwigRoots})
  477.       { $self->setTwigRoots( $args{TwigRoots});
  478.         delete $args{TwigRoots}; 
  479.       }
  480.     
  481.     if( $args{EndTagHandlers})
  482.       { unless ($self->{twig_roots} || $args{ForceEndTagHandlersUsage})
  483.           { croak "you should not use EndTagHandlers without TwigRoots\n",
  484.                   "if you want to use it anyway, normally because you have ",
  485.                   "a start_tag_handlers that calls 'ignore' and you want to ",
  486.                   "call an ent_tag_handlers at the end of the element, then ",
  487.                   "pass 'force_end_tag_handlers_usage => 1' as an argument ",
  488.                   "to new";
  489.           }
  490.                   
  491.         $self->setEndTagHandlers( $args{EndTagHandlers});
  492.         delete $args{EndTagHandlers};
  493.       }
  494.       
  495.     if( $args{TwigPrintOutsideRoots})
  496.       { croak "cannot use TwigPrintOutsideRoots without TwigRoots"
  497.           unless( $self->{twig_roots});
  498.         # if the arg is a filehandle then store it
  499.         if( _is_fh( $args{TwigPrintOutsideRoots}) )
  500.           { $self->{twig_output_fh}= $args{TwigPrintOutsideRoots}; }
  501.         $self->{twig_default_print}= $args{TwigPrintOutsideRoots};
  502.       }
  503.  
  504.     # space policy
  505.     if( $args{KeepSpaces})
  506.       { croak "cannot use both keep_spaces and discard_spaces" if( $args{DiscardSpaces});
  507.         croak "cannot use both keep_spaces and keep_spaces_in" if( $args{KeepSpacesIn});
  508.         $self->{twig_keep_spaces}=1;
  509.         delete $args{KeepSpaces}; 
  510.       }
  511.     if( $args{DiscardSpaces})
  512.       { croak "cannot use both discard_spaces and keep_spaces_in" if( $args{KeepSpacesIn});
  513.         $self->{twig_discard_spaces}=1; 
  514.         delete $args{DiscardSpaces}; 
  515.       }
  516.     if( $args{KeepSpacesIn})
  517.       { croak "cannot use both keep_spaces_in and discard_spaces_in" if( $args{DiscardSpacesIn});
  518.         $self->{twig_discard_spaces}=1; 
  519.         $self->{twig_keep_spaces_in}={}; 
  520.         my @tags= @{$args{KeepSpacesIn}}; 
  521.         foreach my $tag (@tags) { $self->{twig_keep_spaces_in}->{$tag}=1; } 
  522.         delete $args{KeepSpacesIn}; 
  523.       }
  524.     if( $args{DiscardSpacesIn})
  525.       { $self->{twig_keep_spaces}=1; 
  526.         $self->{twig_discard_spaces_in}={}; 
  527.         my @tags= @{$args{DiscardSpacesIn}};
  528.         foreach my $tag (@tags) { $self->{twig_discard_spaces_in}->{$tag}=1; } 
  529.         delete $args{DiscardSpacesIn}; 
  530.       }
  531.     # discard spaces by default 
  532.     $self->{twig_discard_spaces}= 1 unless(  $self->{twig_keep_spaces});
  533.  
  534.     $args{Comments}||= $COMMENTS_DEFAULT;
  535.     if( $args{Comments} eq 'drop')       { $self->{twig_keep_comments}= 0;    }
  536.     elsif( $args{Comments} eq 'keep')    { $self->{twig_keep_comments}= 1;    }
  537.     elsif( $args{Comments} eq 'process') { $self->{twig_process_comments}= 1; }
  538.     else { croak "wrong value for comments argument: '$args{Comments}' (should be 'drop', 'keep' or 'process')"; }
  539.     delete $args{Comments};
  540.  
  541.     $args{Pi}||= $PI_DEFAULT;
  542.     if( $args{Pi} eq 'drop')       { $self->{twig_keep_pi}= 0;    }
  543.     elsif( $args{Pi} eq 'keep')    { $self->{twig_keep_pi}= 1;    }
  544.     elsif( $args{Pi} eq 'process') { $self->{twig_process_pi}= 1; }
  545.     else { croak "wrong value for pi argument: '$args{Pi}' (should be 'drop', 'keep' or 'process')"; }
  546.     delete $args{Pi};
  547.  
  548.     if( $args{KeepEncoding})
  549.       { 
  550.         # set it in XML::Twig::Elt so print functions know what to do
  551.         $self->set_keep_encoding( 1); 
  552.         $self->{parse_start_tag}= $args{ParseStartTag} || \&_parse_start_tag; 
  553.         delete $args{ParseStartTag} if defined( $args{ParseStartTag}) ;
  554.         delete $args{KeepEncoding};
  555.       }
  556.     else
  557.       { $self->set_keep_encoding( 0);  
  558.         $self->{parse_start_tag}= $args{ParseStartTag} if( $args{ParseStartTag}); 
  559.       }
  560.  
  561.     if( $args{OutputFilter})
  562.       { $self->set_output_filter( $args{OutputFilter}); 
  563.         delete $args{OutputFilter};
  564.       }
  565.     else
  566.       { $self->set_output_filter( 0); }
  567.  
  568.     if( $args{RemoveCdata})
  569.       { $self->set_remove_cdata( $args{RemoveCdata}); 
  570.         delete $args{RemoveCdata}; 
  571.       }
  572.     else
  573.       { $self->set_remove_cdata( 0); }
  574.  
  575.     if( $args{OutputTextFilter})
  576.       { $self->set_output_text_filter( $args{OutputTextFilter}); 
  577.         delete $args{OutputTextFilter};
  578.       }
  579.     else
  580.       { $self->set_output_text_filter( 0); }
  581.  
  582.  
  583.     if( exists $args{KeepAttsOrder})
  584.       { $self->{keep_atts_order}= $args{KeepAttsOrder};
  585.         if( _use( 'Tie::IxHash'))
  586.           { $self->set_keep_atts_order(  $self->{keep_atts_order}); }
  587.         else 
  588.           { croak "Tie::IxHash not available, option keep_atts_order not allowed"; }
  589.       }
  590.     else
  591.       { $self->set_keep_atts_order( 0); }
  592.  
  593.  
  594.     if( $args{PrettyPrint})    { $self->set_pretty_print( $args{PrettyPrint}); }
  595.     if( $args{Quote})          { $self->set_quote( $args{Quote});              } 
  596.     if( $args{EmptyTags})      { $self->set_empty_tag_style( $args{EmptyTags}) }
  597.  
  598.     if( exists $args{Id})      { $ID= $args{Id};                     delete $args{ID};             }
  599.     if( $args{NoProlog})       { $self->{no_prolog}= 1;              delete $args{NoProlog};       }
  600.     if( $args{DoNotOutputDTD}) { $self->{no_dtd_output}= 1;          delete $args{DoNotOutputDTD}; }
  601.     if( $args{LoadDTD})        { $self->{twig_read_external_dtd}= 1; delete $args{LoadDTD};        }
  602.     if( $args{CharHandler})    { $self->setCharHandler( $args{CharHandler}); delete $args{CharHandler}; }
  603.  
  604.     if( $args{InputFilter})    { $self->set_input_filter(  $args{InputFilter}); delete  $args{InputFilter}; }
  605.     if( $args{NoExpand})       { $self->setHandlers( %twig_noexpand_handlers); $self->{twig_no_expand}=1; }
  606.     if( my $output_encoding= $args{OutputEncoding}) { $self->set_output_encoding( $output_encoding); delete $args{OutputFilter}; }
  607.  
  608.     if( my $tdh= $args{TopDownHandlers}) { $self->{twig_tdh}=1; delete $args{TopDownHandlers}; }
  609.  
  610.     # set handlers
  611.     if( $self->{twig_roots})
  612.       { if( $self->{twig_default_print})
  613.           { if( $self->{twig_keep_encoding})
  614.               { $self->setHandlers( %twig_handlers_roots_print_original); }
  615.             else
  616.               { $self->setHandlers( %twig_handlers_roots_print);  }
  617.           }
  618.         else
  619.           { $self->setHandlers( %twig_handlers_roots); }
  620.       }
  621.     else
  622.       { $self->setHandlers( %twig_handlers); }
  623.  
  624.     # XML::Parser::Expat does not like these handler to be set. So in order to 
  625.     # use the various sets of handlers on XML::Parser or XML::Parser::Expat
  626.     # objects when needed, these ones have to be set only once, here, at 
  627.     # XML::Parser level
  628.     $self->setHandlers( Init => \&_twig_init, Final => \&_twig_final);
  629.  
  630.     $self->{twig_entity_list}= XML::Twig::Entity_list->new; 
  631.  
  632.     $self->{twig_id}= $ID; 
  633.     $self->{twig_stored_spaces}='';
  634.  
  635.     $self->{twig_autoflush}= 1; # auto flush by default
  636.  
  637.     $self->{twig}= $self;
  638.     weaken( $self->{twig}) if( $weakrefs);
  639.  
  640.     return $self;
  641.   }
  642.  
  643. sub parse
  644.   {
  645.     my $t= shift;
  646.     # if called as a class method, calls nparse, which creates the twig then parses it
  647.     if( !ref( $t) || !isa( $t, 'XML::Twig')) { return $t->nparse( @_); }
  648.  
  649.     # requires 5.006 at least (or the ${^UNICODE} causes a problem)                                       # > perl 5.5
  650.     # trap underlying bug in IO::Handle (see RT #17500)                                                   # > perl 5.5
  651.     # croak if perl 5.8+, -CD (or PERL_UNICODE set to D) and parsing a pipe                               # > perl 5.5
  652.     if( $]>=5.008 && ${^UNICODE} && (${^UNICODE} & 24) && isa( $_[0], 'GLOB') && -p $_[0] )               # > perl 5.5
  653.       { croak   "cannot parse the output of a pipe when perl is set to use the UTF8 perlIO layer\n"       # > perl 5.5
  654.               . "set the environment variable PERL_UNICODE or use the -C option (see perldoc perlrun)\n"  # > perl 5.5
  655.               . "not to include 'D'";                                                                     # > perl 5.5
  656.       }                                                                                                   # > perl 5.5
  657.     $t= eval { $t->SUPER::parse( @_); }; 
  658.     return _checked_parse_result( $t, $@);
  659.   }
  660.  
  661. sub parsefile
  662.   { my $t= shift;
  663.     $t= eval { $t->SUPER::parsefile( @_); };
  664.     return _checked_parse_result( $t, $@);
  665.   }
  666.  
  667. sub _checked_parse_result
  668.   { my( $t, $returned)= @_;
  669.     if( !$t)
  670.       { if( isa( $returned, 'XML::Twig') && $returned->{twig_finish_now})
  671.           { $t= $returned;
  672.             delete $t->{twig_finish_now};
  673.             return $t->_twig_final;
  674.           }
  675.         else
  676.           { _croak( $returned, 0); }
  677.       }
  678.     return $t;
  679.   }
  680.  
  681. sub finish_now
  682.   { my $t= shift;
  683.     $t->{twig_finish_now}=1;
  684.     die $t;    
  685.   }
  686.  
  687.  
  688. sub parsefile_inplace      { shift->_parse_inplace( parsefile      => @_); }
  689. sub parsefile_html_inplace { shift->_parse_inplace( parsefile_html => @_); }
  690.  
  691. sub _parse_inplace
  692.   { my( $t, $method, $file, $suffix)= @_;
  693.     _use( 'File::Temp') || croak "need File::Temp to use inplace methods\n";
  694.     _use( 'File::Basename');
  695.  
  696.  
  697.     my $tmpdir= dirname( $file);
  698.     my( $tmpfh, $tmpfile)= File::Temp::tempfile( DIR => $tmpdir);
  699.     my $original_fh= select $tmpfh;
  700.  
  701.     $t->$method( $file);
  702.  
  703.     select $original_fh;
  704.     close $tmpfh;
  705.     my $mode= (stat( $file))[2] & 07777;
  706.     chmod $mode, $tmpfile or croak "cannot change temp file mode to $mode: $!";
  707.  
  708.     if( $suffix) 
  709.       { my $backup;
  710.         if( $suffix=~ m{\*}) { ($backup = $suffix) =~ s/\*/$file/g; }
  711.         else                 { $backup= $file . $suffix; }
  712.           
  713.         rename( $file, $backup) or croak "cannot backup initial file ($file) to $backup: $!"; 
  714.       }
  715.     rename( $tmpfile, $file) or croak "cannot rename temp file ($tmpfile) to initial file ($file): $!";
  716.  
  717.     return $t;
  718.   }
  719.     
  720.  
  721. sub parseurl
  722.   { my $t= shift;
  723.     $t->_parseurl( 0, @_);
  724.   }
  725.  
  726. sub safe_parseurl
  727.   { my $t= shift;
  728.     $t->_parseurl( 1, @_);
  729.   }
  730.  
  731. sub safe_parsefile_html
  732.   { my $t= shift;
  733.     eval { $t->parsefile_html( @_); };
  734.     return $@ ? $t->_reset_twig &&  0 : $t;
  735.   }
  736.  
  737. sub safe_parseurl_html
  738.   { my $t= shift;
  739.     _use( 'LWP::Simple') or croak "missing LWP::Simple"; 
  740.     eval { $t->parse_html( LWP::Simple::get( shift()), @_); } ;
  741.     return $@ ? $t->_reset_twig &&  0 : $t;
  742.   }
  743.  
  744. # uses eval to catch the parser's death
  745. sub safe_parse_html
  746.   { my $t= shift;
  747.     eval { $t->parse_html( @_); } ;
  748.     return $@ ? $t->_reset_twig &&  0 : $t;
  749.   }
  750.  
  751. sub parsefile_html
  752.   { my $t= shift;
  753.     my $file= shift;
  754.     my $indent= $t->{ErrorContext} ? 1 : 0;
  755.     $t->set_empty_tag_style( 'html');
  756.     $t->parse( _html2xml( _slurp( $file), { indent => $indent }), @_);
  757.     return $t;
  758.   }
  759.  
  760. sub parse_html
  761.   { my $t= shift;
  762.     my $content= shift;
  763.     my $indent= $t->{ErrorContext} ? 1 : 0;
  764.     $t->set_empty_tag_style( 'html');
  765.     $t->parse( _html2xml( isa( $content, 'GLOB') ? _slurp_fh( $content) : $content, { indent => $indent }), @_);
  766.     return $t;
  767.   }
  768.  
  769. sub xparse
  770.   { my $t= shift;
  771.     my $to_parse= $_[0];
  772.     if( isa( $to_parse, 'GLOB'))             { $t->parse( @_);                 }
  773.     elsif( $to_parse=~ m{^\s*<})             { $to_parse=~ m{<html}i ? $t->_parse_as_xml_or_html( @_)
  774.                                                                      : $t->parse( @_);                 
  775.                                              }
  776.     elsif( $to_parse=~ m{^\w+://.*\.html?$}) { _use( 'LWP::Simple') or croak "missing LWP::Simple"; 
  777.                                                $t->_parse_as_xml_or_html( LWP::Simple::get( shift()), @_);
  778.                                              }
  779.     elsif( $to_parse=~ m{^\w+://})           { _use( 'LWP::Simple') or croak "missing LWP::Simple";
  780.                                                my $doc= LWP::Simple::get( shift);
  781.                                                my $xml_parse_ok= $t->safe_parse( $doc, @_);
  782.                                                if( $xml_parse_ok)
  783.                                                  { return $xml_parse_ok; }
  784.                                                else
  785.                                                  { my $diag= $@;
  786.                                                    if( $doc=~ m{<html}i)
  787.                                                      { $t->parse_html( $doc, @_); }
  788.                                                     else
  789.                                                       { croak $diag; }
  790.                                                  }
  791.                                              }
  792.     elsif( $to_parse=~ m{\.html?$})          { my $content= _slurp( shift);
  793.                                                $t->_parse_as_xml_or_html( $content, @_); 
  794.                                              }
  795.     else                                     { $t->parsefile( @_);             }
  796.   }
  797.  
  798. sub _parse_as_xml_or_html
  799.   { my $t= shift; 
  800.     if( _is_well_formed_xml( $_[0]))
  801.       { $t->parse( @_) }
  802.     else
  803.       { my $html= _html2xml( $_[0]);
  804.         if( _is_well_formed_xml( $html))
  805.           { $t->parse( $html); }
  806.         else
  807.           { croak $@; }
  808.       }
  809.   }  
  810.     
  811. { my $parser;
  812.   sub _is_well_formed_xml
  813.     { $parser ||= XML::Parser->new;
  814.       eval { $parser->parse( $_[0]); };
  815.       return $@ ? 0 : 1;
  816.     }
  817. }
  818.  
  819. sub nparse
  820.   { my $class= shift;
  821.     my $to_parse= pop;
  822.     $class->new( @_)->xparse( $to_parse);
  823.   }
  824.  
  825. sub nparse_pp   { shift()->nparse( pretty_print => 'indented', @_); }
  826. sub nparse_e    { shift()->nparse( error_context => 1,         @_); }
  827. sub nparse_ppe  { shift()->nparse( pretty_print => 'indented', error_context => 1, @_); }
  828.  
  829.  
  830. sub _html2xml
  831.   { my( $html, $options)= @_;
  832.     _use( 'HTML::TreeBuilder', '3.13') or croak "cannot parse HTML: missing HTML::TreeBuilder v >= 3.13\n"; 
  833.     my $tree= HTML::TreeBuilder->new;
  834.     $tree->ignore_ignorable_whitespace( 0); 
  835.     $tree->no_space_compacting( 1);
  836.     $tree->store_comments( 1);
  837.     $tree->store_pis(1); 
  838.     $tree->parse( $html);
  839.     $tree->eof;
  840.  
  841.     my $xml= $tree->as_XML;
  842.     _fix_xml( $tree, \$xml);
  843.     $tree->delete;
  844.  
  845.     if( $options->{indent}) { _indent_xhtml( \$xml); }
  846.     $tree->delete;
  847.     return $xml;
  848.   }
  849.  
  850. { my %xml_parser_encoding;
  851.   sub _fix_xml
  852.     { my( $tree, $xml)= @_; # $xml is a ref to the xml string
  853.  
  854.       my $max_tries=5;
  855.       my $add_decl;
  856.  
  857.       while( ! _check_xml( $xml) && $max_tries--)
  858.         { 
  859.           # a couple of fixes for weird HTML::TreeBuilder errors
  860.           if( $@=~ m{^\s*xml declaration not at start of external entity})
  861.             { $$xml=~ s{<\?xml version.*\?>}{}; 
  862.               #warn " fixed xml declaration in the wrong place\n";
  863.             }
  864.           elsif( $@=~ m{^\s*not well-formed \(invalid token\)})
  865.             { my $encoding= _encoding_from_meta( $tree);
  866.               unless( keys %xml_parser_encoding) { %xml_parser_encoding= _xml_parser_encodings(); }
  867.  
  868.               if( ! $add_decl)
  869.                 { if( $xml_parser_encoding{$encoding})
  870.                     { $add_decl=1; }
  871.                   elsif( $encoding eq 'euc-jp' && $xml_parser_encoding{'x-euc-jp-jisx0221'})
  872.                     { $encoding="x-euc-jp-jisx0221"; $add_decl=1;}
  873.                   elsif( $encoding eq 'shift-jis' && $xml_parser_encoding{'x-sjis-jisx0221'})
  874.                     { $encoding="x-sjis-jisx0221";   $add_decl=1;}
  875.  
  876.                   if( $add_decl) 
  877.                     { $$xml=~ s{^(<\?xml.*?\?>)?}{<?xml version="1.0" encoding="$encoding"?>}s;
  878.                       #warn "  added decl (encoding $encoding)\n";
  879.                     }
  880.                   else
  881.                     { $$xml=~ s{^(<\?xml.*?\?>)?}{}s;
  882.                       #warn "  converting to utf8 from $encoding\n";
  883.                       $$xml= _to_utf8( $encoding, $$xml);
  884.                     }
  885.                 }
  886.               else
  887.                 { $$xml=~ s{^(<\?xml.*?\?>)?}{}s;
  888.                   #warn "  converting to utf8 from $encoding\n";
  889.                   $$xml= _to_utf8( $encoding, $$xml);
  890.                 }
  891.             }
  892.       }
  893.   }
  894.  
  895.   sub _xml_parser_encodings
  896.     { my @encodings=( 'iso-8859-1'); # this one is included by default, there is no map for it in @INC
  897.       foreach my $inc (@INC)
  898.         { push @encodings, map { basename( $_, '.enc') } glob( File::Spec->catdir( $inc => XML => Parser => Encodings => '*.enc')); }
  899.       return map { $_ => 1 } @encodings;
  900.     }
  901. }
  902.  
  903. sub _check_xml
  904.   { my( $xml)= @_; # $xml is a ref to the xml string
  905.     my $ok= eval { XML::Parser->new->parse( $$xml); };
  906.     #if( $ok) { warn "  parse OK\n"; }
  907.     return $ok;
  908.   }
  909.  
  910. sub _encoding_from_meta
  911.   { my( $tree)= @_; 
  912.     my $enc="iso-8859-1";
  913.     my @meta= $tree->find( 'meta');
  914.     foreach my $meta (@meta)
  915.       { if(    $meta->{'http-equiv'} && ($meta->{'http-equiv'} =~ m{^\s*content-type\s*}i)
  916.             && $meta->{content}      && ($meta->{content}      =~ m{^\s*text/html\s*;\s*charset\s*=\s*(\S*)\s*}i)
  917.           )
  918.           { $enc= lc $1;
  919.             #warn "  encoding from meta tag is '$enc'\n";
  920.             last;
  921.           }
  922.       }
  923.     return $enc;
  924.   }
  925.  
  926. { sub _to_utf8 
  927.     { my( $encoding, $string)= @_;
  928.       local $SIG{__DIE__};
  929.       if( _use(  'Encode')) 
  930.         { Encode::from_to( $string, $encoding => 'utf8', 0x0400); } # 0x0400 is Encode::FB_XMLCREF
  931.       elsif( _use( 'Text::Iconv'))
  932.         { my $converter =  eval { Text::Iconv->new( $encoding => "utf8") };
  933.           if( $converter) {  $string= $converter->convert( $string); }
  934.         }
  935.       elsif( _use( 'Unicode::Map8') && _use( 'Unicode::String'))
  936.         { my $map= Unicode::Map8->new( $encoding); 
  937.           $string= $map->tou( $string)->utf8;
  938.         }
  939.       $string=~ s{[\x00-\x08\x0B\x0C\x0E-\x1F]}{}g; # get rid of control chars, portable in 5.6
  940.     return $string;
  941.   }
  942. }
  943.  
  944.  
  945. sub _indent_xhtml
  946.   { my( $xhtml)= @_; # $xhtml is a ref
  947.     my %block_tag= map { $_ => 1 } qw( html 
  948.                                          head 
  949.                                            meta title link script base
  950.                                          body 
  951.                                            h1 h2 h3 h4 h5 h6 
  952.                                            p br address  blockquote pre 
  953.                                            ol ul li  dd dl dt 
  954.                                            table tr td th tbody tfoot thead  col colgroup caption 
  955.                                            div frame frameset hr
  956.                                      ); 
  957.  
  958.     my $level=0;
  959.     $$xhtml=~ s{( (?:<!(?:--.*?-->|[CDATA[.*]]>)) # ignore comments and CDATA sections
  960.                   | <(\w+)                        # start tag
  961.                   |(</\(\w+)                      # end tag 
  962.                 )
  963.                }
  964.                {
  965.                  if(    $2 && $block_tag{$2})  { my $indent= "  " x $level; 
  966.                                                  $level++ unless( $2=~ m{/>});
  967.                                                  "\n$indent<$2"; 
  968.                                                }
  969.                  elsif( $3  && $block_tag{$3}) { $level--; "</$3"; }
  970.                  else                          { $1; }
  971.                }xesg;
  972.   }
  973.  
  974.  
  975. sub add_stylesheet
  976.   { my( $t, $type, $href)= @_;
  977.     my %text_type= map { $_ => 1 } qw( xsl css);
  978.     my $ss= $t->{twig_elt_class}->new( '#PI');
  979.     if( $text_type{$type}) 
  980.       { $ss->_set_pi( 'xml-stylesheet', qq{type="text/$type" href="$href"}); }
  981.     else
  982.       { croak "unsupported style sheet type '$type'"; }
  983.       
  984.     $t->_add_cpi_outside_of_root( leading_cpi => $ss);
  985.     return $t;
  986.   }
  987.  
  988. { my %used;       # module => 1 if require ok, 0 otherwise
  989.   my %disallowed; # for testing, refuses to _use modules in this hash
  990.  
  991.   sub _disallow_use
  992.     { my( @modules)= @_;
  993.       $disallowed{$_}= 1 foreach (@modules);
  994.     }
  995.  
  996.   sub _allow_use
  997.     { my( @modules)= @_;
  998.       $disallowed{$_}= 0 foreach (@modules);
  999.     }
  1000.  
  1001.   sub _use
  1002.     { my( $module, $version)= @_;
  1003.       $version ||= 0;
  1004.       if( $disallowed{$module})   { return 0; }
  1005.       if( $used{$module})         { return 1; }
  1006.       if( eval "require $module") { import $module; $used{$module}= 1; 
  1007.                                     no strict 'refs';
  1008.                                     if( ${"${module}::VERSION"} >= $version ) { return 1; }
  1009.                                     else                                      { return 0; }
  1010.                                   }
  1011.       else                        {                          $used{$module}= 0; return 0; }
  1012.     }
  1013. }
  1014.  
  1015. # used to solve the [n] predicates while avoiding getting the entire list
  1016. sub _first_n(&$@)        # needs a prototype to accept passing bare blocks
  1017.   { my $coderef= shift;
  1018.     my $n= shift;         
  1019.     my $i=0;
  1020.     if( $n > 0)
  1021.       { foreach (@_)         { if( &$coderef) { $i++; return $_ if( $i == $n); } } }
  1022.     elsif( $n < 0)
  1023.       { foreach (reverse @_) { if( &$coderef) { $i--; return $_ if( $i == $n); } } }
  1024.     else
  1025.       { croak "illegal position number 0"; }
  1026.     return undef;
  1027.   }
  1028.  
  1029. sub _slurp_uri
  1030.   { my( $uri, $base)= @_;
  1031.     if( $uri=~ m{^\w+://}) { _use( 'LWP::Simple'); return LWP::Simple::get( $uri); }
  1032.     else                   { return _slurp( _based_filename( $uri, $base));        }
  1033.   }
  1034.  
  1035. sub _based_filename
  1036.   { my( $filename, $base)= @_;
  1037.     # cf. XML/Parser.pm's file_ext_ent_handler
  1038.     if (defined($base) and not ($filename =~ m{^(?:[\\/]|\w+:)})) 
  1039.           { my $newpath = $base;
  1040.             $newpath =~ s{[^\\/:]*$}{$filename};
  1041.             $filename = $newpath;
  1042.           }
  1043.     return $filename;
  1044.   }
  1045.  
  1046. sub _slurp
  1047.   { my( $filename)= @_;
  1048.     # use bareword filehandle to stay compatible with real old perl
  1049.     open( TWIG_TO_SLURP, "<$filename") or croak "cannot open '$filename': $!"; 
  1050.     local $/= undef;
  1051.     my $content= <TWIG_TO_SLURP>;
  1052.     close TWIG_TO_SLURP;
  1053.     return $content;
  1054.   }
  1055.   
  1056. sub _slurp_fh
  1057.   { my( $fh)= @_;
  1058.     local $/= undef;
  1059.     my $content= <$fh>;
  1060.     return $content;
  1061.   }    
  1062.  
  1063. # I should really add extra options to allow better configuration of the 
  1064. # LWP::UserAgent object
  1065. # this method forks (except on VMS!)
  1066. #   - the child gets the data and copies it to the pipe,
  1067. #   - the parent reads the stream and sends it to XML::Parser
  1068. # the data is cut it chunks the size of the XML::Parser::Expat buffer
  1069. # the method returns the twig and the status
  1070. sub _parseurl
  1071.   { my( $t, $safe, $url, $agent)= @_;
  1072.     _use( 'LWP') || croak "LWP not available, needed to use parseurl methods";
  1073.     if( $^O ne 'VMS')
  1074.       { pipe( README, WRITEME) or croak  "cannot create connected pipes: $!";
  1075.         if( my $pid= fork)
  1076.           { # parent code: parse the incoming file
  1077.             close WRITEME; # no need to write
  1078.             my $result= $safe ? $t->safe_parse( \*README) : $t->parse( \*README);
  1079.             close README;
  1080.             return $@ ? 0 : $t;
  1081.           }
  1082.         else
  1083.          { # child
  1084.             close README; # no need to read
  1085.             $|=1;
  1086.             $agent    ||= LWP::UserAgent->new;
  1087.             my $request  = HTTP::Request->new( GET => $url);
  1088.             # _pass_url_content is called with chunks of data the same size as
  1089.             # the XML::Parser buffer 
  1090.             my $response = $agent->request( $request, 
  1091.                              sub { _pass_url_content( \*WRITEME, @_); }, BUFSIZE);
  1092.             $response->is_success or croak "$url ", $response->message;
  1093.             close WRITEME;
  1094.             CORE::exit(); # CORE is there for mod_perl (which redefines exit)
  1095.           }
  1096.       } 
  1097.     else 
  1098.       { $|=1;
  1099.         $agent    ||= LWP::UserAgent->new;
  1100.         my $request  = HTTP::Request->new( GET => $url);
  1101.         my $response = $agent->request( $request);
  1102.         $response->is_success or croak "$url ", $response->message;
  1103.         my $result= $safe ? $t->safe_parse($response->content) : $t->parse($response->content);
  1104.         return $@ ? 0 : $t;
  1105.      }
  1106.  
  1107.   }
  1108.  
  1109. # get the (hopefully!) XML data from the URL and 
  1110. sub _pass_url_content
  1111.   { my( $fh, $data, $response, $protocol)= @_;
  1112.     print {$fh} $data;
  1113.   }
  1114.  
  1115. sub add_options
  1116.   { my %args= map { $_, 1 } @_;
  1117.     %args= _normalize_args( %args);
  1118.     foreach (keys %args) { $valid_option{$_}++; } 
  1119.   }
  1120.  
  1121. sub _twig_store_internal_dtd
  1122.  { 
  1123.    # warn " in _twig_store_internal_dtd...\n"; # DEBUG handler
  1124.     my( $p, $string)= @_;
  1125.     my $t= $p->{twig};
  1126.     $string= $p->original_string() if( $t->{twig_keep_encoding});
  1127.     $t->{twig_doctype}->{internal} .= $string;
  1128.   }
  1129.  
  1130. sub _twig_stop_storing_internal_dtd
  1131.    { # warn " in _twig_stop_storing_internal_dtd...\n"; # DEBUG handler
  1132.     my $p= shift;
  1133.     if( @saved_default_handler && defined $saved_default_handler[1])
  1134.       { $p->setHandlers( @saved_default_handler); }
  1135.     else
  1136.       { my $t= $p->{twig};
  1137.         $p->setHandlers( Default => undef);
  1138.       }
  1139.     $p->{twig}->{twig_doctype}->{internal}=~ s{^\s*\[}{};
  1140.     $p->{twig}->{twig_doctype}->{internal}=~ s{\]\s*$}{};
  1141.   }
  1142.  
  1143. sub _twig_doctype_fin_print
  1144.    { # warn " in _twig_doctype_fin_print...\n"; # DEBUG handler
  1145.     my( $p)= shift;
  1146.     if( $p->{twig}->{twig_doctype}->{has_internal} && !$p->{twig}->{expat_1_95_2}) { print ' ]>'; }
  1147.   }
  1148.     
  1149.  
  1150. sub _normalize_args
  1151.   { my %normalized_args;
  1152.     while( my $key= shift )
  1153.       { $key= join '', map { ucfirst } split /_/, $key;
  1154.         #$key= "Twig".$key unless( substr( $key, 0, 4) eq 'Twig');
  1155.         $normalized_args{$key}= shift ;
  1156.       }
  1157.     return %normalized_args;
  1158.   }    
  1159.  
  1160. sub _is_fh { return unless $_[0]; return $_[0] if( isa( $_[0], 'GLOB') || isa( $_[0], 'IO::Scalar')); }
  1161.  
  1162. sub _set_handler
  1163.   { my( $handlers, $path, $handler)= @_;
  1164.  
  1165.     my $prev_handler= $handlers->{handlers}->{string}->{$path} || undef;
  1166.  
  1167.        _set_special_handler         ( $handlers, $path, $handler, $prev_handler)
  1168.     || _set_pi_handler              ( $handlers, $path, $handler, $prev_handler)
  1169.     || _set_level_handler           ( $handlers, $path, $handler, $prev_handler)
  1170.     || _set_regexp_handler          ( $handlers, $path, $handler, $prev_handler)
  1171.     || _set_xpath_handler           ( $handlers, $path, $handler, $prev_handler)
  1172.     || croak "unrecognized expression in handler: '$path'";
  1173.  
  1174.  
  1175.     # this both takes care of the simple (gi) handlers and store
  1176.     # the handler code reference for other handlers
  1177.     $handlers->{handlers}->{string}->{$path}= $handler;
  1178.  
  1179.     return $prev_handler;
  1180.   }
  1181.  
  1182.  
  1183. sub _set_special_handler
  1184.   { my( $handlers, $path, $handler, $prev_handler)= @_;
  1185.     if( $path =~ m{^\s*($ALL|$DEFAULT|#COMMENT)\s*$}io )
  1186.       { $handlers->{handlers}->{$1}= $handler; 
  1187.         return 1;
  1188.       }
  1189.     else 
  1190.       { return 0; }
  1191.   }
  1192.  
  1193. sub _set_xpath_handler
  1194.   { my( $handlers, $path, $handler, $prev_handler)= @_;
  1195.     if( my $handler_data= _parse_xpath_handler( $path, $handler))
  1196.       { _add_handler( $handlers, $handler_data, $path, $prev_handler);
  1197.         return 1;
  1198.       }
  1199.     else 
  1200.       { return 0; }
  1201.   }
  1202.  
  1203. sub _add_handler
  1204.   { my( $handlers, $handler_data, $path, $prev_handler)= @_;
  1205.  
  1206.     my $tag= $handler_data->{tag};
  1207.     my @handlers= $handlers->{xpath_handler}->{$tag} ? @{$handlers->{xpath_handler}->{$tag}} : ();
  1208.  
  1209.     if( $prev_handler) { @handlers= grep { $_->{path} ne $path } @handlers; }
  1210.  
  1211.     push @handlers, $handler_data if( $handler_data->{handler});
  1212.     
  1213.  
  1214.     @handlers= sort {    (($a->{score}->{type}        || 0)  <=>  ($b->{score}->{type}        || 0))
  1215.                       || (($b->{score}->{anchored}    || 0)  <=>  ($a->{score}->{anchored}    || 0))
  1216.                       || (($b->{score}->{steps}       || 0)  <=>  ($a->{score}->{steps}       || 0))
  1217.                       || (($b->{score}->{predicates}  || 0)  <=>  ($a->{score}->{predicates}  || 0))
  1218.                       || (($b->{score}->{tests}       || 0)  <=>  ($a->{score}->{tests}       || 0))
  1219.                       || ($a->{path} cmp $a->{path})
  1220.                     } @handlers;
  1221.  
  1222.     $handlers->{xpath_handler}->{$tag}= \@handlers;
  1223.   }
  1224.  
  1225. sub _set_pi_handler
  1226.   { my( $handlers, $path, $handler, $prev_handler)= @_;
  1227.     # PI conditions ( '?target' => \&handler or '?' => \&handler
  1228.     #             or '#PItarget' => \&handler or '#PI' => \&handler)
  1229.     if( $path=~ /^\s*(?:\?|#PI)\s*(?:([^\s]*)\s*)$/)
  1230.       { my $target= $1 || '';
  1231.         # update the path_handlers count, knowing that
  1232.         # either the previous or the new handler can be undef
  1233.         $handlers->{pi_handlers}->{$1}= $handler;
  1234.         return 1;
  1235.       }
  1236.     else 
  1237.       { return 0; 
  1238.       }
  1239.   }
  1240.  
  1241. sub _set_level_handler
  1242.   { my( $handlers, $path, $handler, $prev_handler)= @_;
  1243.     if( $path =~ m{^ \s* level \s* \( \s* ([0-9]+) \s* \) \s* $}ox )
  1244.       { my $level= $1;
  1245.         my $sub= sub { my( $stack)= @_; return( ($stack->[-1]->{_tag} !~ m{^#}) && (scalar @$stack == $level + 1) ) }; 
  1246.         my $handler_data=  { tag=> '*', score => { type => $LEVEL_TRIGGER}, trigger => $sub, 
  1247.                              path => $path, handler => $handler, test_on_text => 0
  1248.                            };
  1249.         _add_handler( $handlers, $handler_data, $path, $prev_handler);
  1250.         return 1;
  1251.       }
  1252.     else 
  1253.       { return 0; }
  1254.   }
  1255.  
  1256. sub _set_regexp_handler
  1257.   { my( $handlers, $path, $handler, $prev_handler)= @_; 
  1258.     # if the expression was a regexp it is now a string (it was stringified when it became a hash key)
  1259.     if( $path=~ m{^\(\?([xism]*)(?:-[xism]*)?:(.*)\)$}) 
  1260.       { my $regexp= qr/(?$1:$2)/; # convert it back into a regexp
  1261.         my $sub= sub { my( $stack)= @_; return( $stack->[-1]->{_tag} =~ $regexp ) }; 
  1262.         my $handler_data=  { tag=> '*', score => { type => $REGEXP_TRIGGER} , trigger => $sub, 
  1263.                              path => $path, handler => $handler, test_on_text => 0 
  1264.                            };
  1265.         _add_handler( $handlers, $handler_data, $path, $prev_handler);
  1266.         return 1;
  1267.       }
  1268.     else 
  1269.       { return 0; }
  1270.   }
  1271.  
  1272. sub _parse_xpath_handler
  1273.   { my( $xpath, $handler)= @_;
  1274.     my $xpath_original= $xpath;
  1275.  
  1276.     my $DEBUG_HANDLER= 0; # 0 or 1 (output the handler checking code) or 2 (super verbose)
  1277.  
  1278.     if( $DEBUG_HANDLER >=1) { warn "\n\nparsing path '$xpath'\n"; }
  1279.  
  1280.     my $path_to_check= $xpath;
  1281.     $path_to_check=~ s{/?/?$REG_NAME_W?\s*(?:$REG_PREDICATE\s*)?}{}g;
  1282.     if( $DEBUG_HANDLER && $path_to_check=~ /\S/) { warn "left: $path_to_check\n"; }
  1283.     return if( $path_to_check=~ /\S/);
  1284.  
  1285.     (my $xpath_to_display= $xpath)=~ s{(["{}'\[\]\@\$])}{\\$1}g;
  1286.  
  1287.     #my @xpath_steps= split /(?<!\\)(\/\/?)/, $xpath; 
  1288.     my @xpath_steps;
  1289.     my $last_token_is_sep;
  1290.     while( $xpath=~ s{^\s*
  1291.                        ( (//?)                                      # separator
  1292.                         | (?:$REG_NAME_W\s*(?:$REG_PREDICATE\s*)?) # tag name and optional predicate
  1293.                         | (?:$REG_PREDICATE)                       # just a predicate
  1294.                        )
  1295.                      }
  1296.                      {}x
  1297.          )
  1298.       { # check that we have alternating separators and steps
  1299.         if( $2) # found a separator
  1300.           { if(  $last_token_is_sep) { return 0; } # 2 seps in a row
  1301.             $last_token_is_sep= 1;
  1302.           }
  1303.         else
  1304.           { if( defined( $last_token_is_sep) && !$last_token_is_sep) { return 0; } # 2 steps in a row
  1305.             $last_token_is_sep= 0;
  1306.           }
  1307.  
  1308.         push @xpath_steps, $1;
  1309.       }
  1310.     if( $last_token_is_sep) { return 0; } # expression cannot end with a separator 
  1311.  
  1312.     my $i=-1;
  1313.  
  1314.     my $perlfunc= _join_n( q#my( $stack)= @_;                    #,
  1315.                            q#local $^W = 0;                      #,
  1316.                            q#my @current_elts= (scalar @$stack); #,
  1317.                            q#my @new_current_elts;               #,
  1318.                            q#my $elt;                            #,
  1319.                            ($DEBUG_HANDLER >= 1) && (qq#warn q{checking path '$xpath_to_display'\n};#),
  1320.                          );
  1321.  
  1322.  
  1323.     my $last_tag='';
  1324.     my $anchored= $xpath_original=~ m{^\s*/(?!/)} ? 1 : 0; 
  1325.     my $score={ type => $XPATH_TRIGGER, anchored => $anchored };
  1326.     my $flag= { test_on_text => 0 };
  1327.     my $sep='/';  # '/' or '//'
  1328.     while( my $xpath_step= pop @xpath_steps)
  1329.       { my( $tag, $predicate)= $xpath_step =~ m{^($REG_NAME_W)?(?:\[(.*)\])?\s*$};
  1330.         $score->{steps}++;
  1331.         $tag||='*';
  1332.  
  1333.         my $warn_empty_stack= $DEBUG_HANDLER >= 2 ? qq{warn "return with empty stack\\n";} : '';
  1334.  
  1335.         if( $predicate)
  1336.           { if( $DEBUG_HANDLER >= 2)  { warn "predicate is: '$predicate'\n"; }
  1337.             # changes $predicate (from an XPath expression to a Perl one)
  1338.             _parse_predicate_in_handler( $predicate, $flag, $score);
  1339.             if( $DEBUG_HANDLER >= 2) { warn "predicate becomes: '$predicate'\n"; }
  1340.           }
  1341.  
  1342.        my $tag_cond=  $tag ne '*' ? qq#(\$elt->{_tag} eq "$tag")# : '';
  1343.        my $cond= join( " && ", grep { $_ } $tag_cond, $predicate);
  1344.  
  1345.        $last_tag ||= $tag;
  1346.  
  1347.  
  1348.        if( $sep eq '/')
  1349.          { 
  1350.            $perlfunc .= sprintf( _join_n(  q#foreach my $current_elt (@current_elts)              #,
  1351.                                            q#  { next if( !$current_elt);                         #,
  1352.                                            q#    $current_elt--;                                  #,
  1353.                                            q#    $elt= $stack->[$current_elt];                    #,
  1354.                                            q#    if( %s) { push @new_current_elts, $current_elt;} #,
  1355.                                            q#  }                                                  #,
  1356.                                         ),
  1357.                                  $cond
  1358.                                );
  1359.          }
  1360.        elsif( $sep eq '//')
  1361.          { 
  1362.            $perlfunc .= sprintf( _join_n(  q#foreach my $current_elt (@current_elts)                #,
  1363.                                            q#  { next if( !$current_elt);                           #,
  1364.                                            q#    $current_elt--;                                    #,
  1365.                                            q#    my $candidate= $current_elt;                       #,
  1366.                                            q#    while( $candidate >=0)                             #,
  1367.                                            q#      { $elt= $stack->[$candidate];                    #,
  1368.                                            q#        if( %s) { push @new_current_elts, $candidate;} #,
  1369.                                            q#        $candidate--;                                  #,
  1370.                                            q#      }                                                #,
  1371.                                            q#  }                                                    #,
  1372.                                         ),
  1373.                                  $cond
  1374.                                );
  1375.          }
  1376.        my $warn= $DEBUG_HANDLER >= 2 ? _join_n( qq#warn qq%fail at cond '$cond'%;#) : '';
  1377.        $perlfunc .= sprintf( _join_n( q#unless( @new_current_elts) { %s return 0; } #,
  1378.                                       q#@current_elts= @new_current_elts;           #,
  1379.                                       q#@new_current_elts=();                       #,
  1380.                                     ),
  1381.                              $warn
  1382.                            );
  1383.  
  1384.         $sep= pop @xpath_steps;
  1385.      }
  1386.  
  1387.     if( $anchored) # there should be a better way, but this works
  1388.       {  
  1389.        my $warn= $DEBUG_HANDLER >= 2 ? _join_n( qq#warn qq{fail, stack not empty};#) : '';
  1390.        $perlfunc .= sprintf( _join_n( q#if( ! grep { $_ == 0 } @current_elts) { %s return 0;}#), $warn);
  1391.       }
  1392.  
  1393.     $perlfunc.= qq{warn "handler for '$xpath_to_display' triggered\\n";\n} if( $DEBUG_HANDLER >=2);
  1394.     $perlfunc.= qq{return q{$xpath_original};\n};
  1395.     warn "\nperlfunc:\n$perlfunc\n" if( $DEBUG_HANDLER>=1);
  1396.     my $s= eval "sub { $perlfunc }";
  1397.       if( $@) 
  1398.         { croak "wrong handler condition '$xpath' ($@);" }
  1399.  
  1400.       warn "last tag: '$last_tag', test_on_text: '$flag->{test_on_text}'\n" if( $DEBUG_HANDLER >=1);
  1401.       warn "score: ", join( ' ', map { "$_: $score->{$_}" } sort keys %$score), "\n" if( $DEBUG_HANDLER >=1);
  1402.       return { tag=> $last_tag, score => $score, trigger => $s, path => $xpath_original, handler => $handler, test_on_text => $flag->{test_on_text} };
  1403.     }
  1404.  
  1405. sub _join_n { return join( "\n", @_, ''); }
  1406.  
  1407. # input: the predicate ($_[0]) which will be changed in place
  1408. #        flags, a hashref with various flags (like test_on_text)
  1409. #        the score 
  1410. sub _parse_predicate_in_handler
  1411.   { my( $flag, $score)= @_[1..2];
  1412.     $_[0]=~ s{(   ($REG_STRING)                        # strings
  1413.                  |\@($REG_NAME)(?=\s*(?:[><=!]|!~|=~)) # @att (followed by a comparison operator)
  1414.                  |\@($REG_NAME)                        # @att (not followed by a comparison operator)
  1415.                  |=~|!~                                # matching operators
  1416.                  |([><]=?|=|!=)(?=\s*[\d+-])           # test before a number
  1417.                  |([><]=?|=|!=)                        # test, other cases
  1418.                  |($REG_FUNCTION)                      # no arg functions
  1419.                  # this bit is a mess, but it is the only solution with this half-baked parser
  1420.                  |(string\(\s*$REG_NAME\s*\)\s*$REG_MATCH\s*$REG_REGEXP)  # string( child)=~ /regexp/
  1421.                  |(string\(\s*$REG_NAME\s*\)\s*$REG_COMP\s*$REG_STRING) # string( child) = "value" (or other test)
  1422.                  |(string\(\s*$REG_NAME\s*\)\s*$REG_COMP\s*$REG_NUMBER) # string( child) = nb (or other test)
  1423.                  |(and|or)
  1424.               )}
  1425.              { my( $token, $string, $att, $bare_att, $num_test, $alpha_test, $func, $string_regexp, $string_test_alpha, $string_test_num, $and_or) 
  1426.                = ( $1,     $2,      $3,   $4,        $5,        $6,          $7,    $8,             $9,                 $10,              $11); 
  1427.     
  1428.                $score->{predicates}++;
  1429.               
  1430.                # store tests on text (they are not always allowed)
  1431.                if( $func || $string_regexp || $string_test_num || $string_test_alpha ) { $flag->{test_on_text}= 1;   }
  1432.  
  1433.                if( defined $string)   { $token }
  1434.                elsif( $att)           { $att=~ m{^#} ? qq{ (\$elt->{_elt} && \$elt->{_elt}->{att}->{'$att'})}
  1435.                                                      : qq{\$elt->{'$att'}}
  1436.                                       }
  1437.                elsif( $bare_att)      { $bare_att=~ m{^#} ? qq{(\$elt->{_elt} && defined(\$elt->{_elt}->{att}->{'$bare_att'}))}
  1438.                                                           : qq{defined( \$elt->{'$bare_att'})}
  1439.                                       }
  1440.                elsif( $num_test && ($num_test eq '=') ) { "==" } # others tests are unchanged
  1441.                elsif( $alpha_test)    { $PERL_ALPHA_TEST{$alpha_test} }
  1442.                elsif( $func && $func=~ m{^string})
  1443.                                       { "\$elt->{_elt}->text"; }
  1444.                elsif( $string_regexp && $string_regexp =~ m{string\(\s*($REG_NAME)\s*\)\s*($REG_MATCH)\s*($REG_REGEXP)})
  1445.                                       { "defined( _first_n {  \$_->text $2 $3 } 1, \$elt->{_elt}->_children( '$1'))"; }
  1446.                elsif( $string_test_alpha && $string_test_alpha     =~ m{string\(\s*($REG_NAME)\s*\)\s*($REG_COMP)\s*($REG_STRING)})
  1447.                                       { my( $tag, $op, $str)= ($1, $2, $3);
  1448.                                         $str=~ s{(?<=.)'(?=.)}{\\'}g; # escape a quote within the string 
  1449.                                         $str=~ s{^"}{'};
  1450.                                         $str=~ s{"$}{'};
  1451.                                         "defined( _first_n { \$_->text $PERL_ALPHA_TEST{$op} $str } 1, \$elt->{_elt}->children( '$tag'))"; }
  1452.                elsif( $string_test_num && $string_test_num   =~ m{string\(\s*($REG_NAME)\s*\)\s*($REG_COMP)\s*($REG_NUMBER)})
  1453.                                       { my $test= ($2 eq '=') ? '==' : $2;
  1454.                                         "defined( _first_n { \$_->text $test $3 } 1, \$elt->{_elt}->children( '$1'))"; 
  1455.                                       }
  1456.                elsif( $and_or)        { $score->{tests}++; $and_or eq 'and' ? '&&' : '||' ; }
  1457.                else                   { $token; }
  1458.              }gexs;
  1459.   }
  1460.     
  1461.  
  1462. sub setCharHandler
  1463.   { my( $t, $handler)= @_;
  1464.     $t->{twig_char_handler}= $handler;
  1465.   }
  1466.  
  1467.  
  1468. sub _reset_handlers
  1469.   { my $handlers= shift;
  1470.     delete $handlers->{handlers};
  1471.     delete $handlers->{path_handlers};
  1472.     delete $handlers->{subpath_handlers};
  1473.     $handlers->{attcond_handlers_exp}=[] if( $handlers->{attcond_handlers});
  1474.     delete $handlers->{attcond_handlers};
  1475.   }
  1476.   
  1477. sub _set_handlers
  1478.   { my $handlers= shift || return;
  1479.     my $set_handlers= {};
  1480.     foreach my $path (keys %{$handlers})
  1481.       { _set_handler( $set_handlers, $path, $handlers->{$path}); }
  1482.     return $set_handlers;
  1483.   }
  1484.     
  1485.  
  1486. sub setTwigHandler
  1487.   { my( $t, $path, $handler)= @_;
  1488.     $t->{twig_handlers} ||={};
  1489.     return _set_handler( $t->{twig_handlers}, $path, $handler);
  1490.   }
  1491.  
  1492. sub setTwigHandlers
  1493.   { my( $t, $handlers)= @_;
  1494.     my $previous_handlers= $t->{twig_handlers} || undef;
  1495.     _reset_handlers( $t->{twig_handlers});
  1496.     $t->{twig_handlers}= _set_handlers( $handlers);
  1497.     return $previous_handlers;
  1498.   }
  1499.  
  1500. sub setStartTagHandler
  1501.   { my( $t, $path, $handler)= @_;
  1502.     $t->{twig_starttag_handlers}||={};
  1503.     return _set_handler( $t->{twig_starttag_handlers}, $path, $handler);
  1504.   }
  1505.  
  1506. sub setStartTagHandlers
  1507.   { my( $t, $handlers)= @_;
  1508.     my $previous_handlers= $t->{twig_starttag_handlers} || undef;
  1509.     _reset_handlers( $t->{twig_starttag_handlers});
  1510.     $t->{twig_starttag_handlers}= _set_handlers( $handlers);
  1511.     return $previous_handlers;
  1512.    }
  1513.  
  1514. sub setIgnoreEltsHandler
  1515.   { my( $t, $path, $action)= @_;
  1516.     $t->{twig_ignore_elts_handlers}||={};
  1517.     return _set_handler( $t->{twig_ignore_elts_handlers}, $path, $action );
  1518.   }
  1519.  
  1520. sub setIgnoreEltsHandlers
  1521.   { my( $t, $handlers)= @_;
  1522.     my $previous_handlers= $t->{twig_ignore_elts_handlers};
  1523.     _reset_handlers( $t->{twig_ignore_elts_handlers});
  1524.     $t->{twig_ignore_elts_handlers}= _set_handlers( $handlers);
  1525.     return $previous_handlers;
  1526.    }
  1527.  
  1528. sub setEndTagHandler
  1529.   { my( $t, $path, $handler)= @_;
  1530.     $t->{twig_endtag_handlers}||={};
  1531.     return _set_handler( $t->{twig_endtag_handlers}, $path,$handler);
  1532.   }
  1533.  
  1534. sub setEndTagHandlers
  1535.   { my( $t, $handlers)= @_;
  1536.     my $previous_handlers= $t->{twig_endtag_handlers};
  1537.     _reset_handlers( $t->{twig_endtag_handlers});
  1538.     $t->{twig_endtag_handlers}= _set_handlers( $handlers);
  1539.     return $previous_handlers;
  1540.    }
  1541.  
  1542. # a little more complex: set the twig_handlers only if a code ref is given
  1543. sub setTwigRoots
  1544.   { my( $t, $handlers)= @_;
  1545.     my $previous_roots= $t->{twig_roots};
  1546.     _reset_handlers($t->{twig_roots});
  1547.     $t->{twig_roots}= _set_handlers( $handlers);
  1548.  
  1549.     _check_illegal_twig_roots_handlers( $t->{twig_roots});
  1550.     
  1551.     foreach my $path (keys %{$handlers})
  1552.       { $t->{twig_handlers}||= {};
  1553.         _set_handler( $t->{twig_handlers}, $path, $handlers->{$path})
  1554.           if( isa( $handlers->{$path}, 'CODE')); 
  1555.       }
  1556.     return $previous_roots;
  1557.   }
  1558.  
  1559. sub _check_illegal_twig_roots_handlers
  1560.   { my( $handlers)= @_;
  1561.     foreach my $tag_handlers (values %{$handlers->{xpath_handler}})
  1562.       { foreach my $handler_data (@$tag_handlers)
  1563.           { if( my $type= $handler_data->{test_on_text})
  1564.               { croak "string() condition not supported on twig_roots option"; }
  1565.           }
  1566.       }
  1567.   }
  1568.     
  1569.  
  1570. # just store the reference to the expat object in the twig
  1571. sub _twig_init
  1572.    { # warn " in _twig_init...\n"; # DEBUG handler
  1573.     
  1574.     my $p= shift;
  1575.     my $t=$p->{twig};
  1576.  
  1577.     if( $t->{twig_parsing} ) { croak "cannot reuse a twig that is already parsing"; }
  1578.     $t->{twig_parsing}=1;
  1579.  
  1580.     $t->{twig_parser}= $p; 
  1581.     weaken( $t->{twig_parser}) if( $weakrefs);
  1582.  
  1583.     # in case they had been created by a previous parse
  1584.     delete $t->{twig_dtd};
  1585.     delete $t->{twig_doctype};
  1586.     delete $t->{twig_xmldecl};
  1587.     delete $t->{twig_root};
  1588.  
  1589.     # if needed set the output filehandle
  1590.     $t->_set_fh_to_twig_output_fh();
  1591.   }
  1592.  
  1593. # uses eval to catch the parser's death
  1594. sub safe_parse
  1595.   { my $t= shift;
  1596.     eval { $t->parse( @_); } ;
  1597.     return $@ ? $t->_reset_twig &&  0 : $t;
  1598.   }
  1599.  
  1600. sub safe_parsefile
  1601.   { my $t= shift;
  1602.     eval { $t->parsefile( @_); } ;
  1603.     return $@ ? $t->_reset_twig : $t;
  1604.   }
  1605.  
  1606. # restore a twig in a proper state so it can be reused for a new parse
  1607. sub _reset_twig
  1608.   { my $t= shift;
  1609.     $t->{twig_parsing}= 0;
  1610.     delete $t->{twig_current};
  1611.     delete $t->{extra_data};
  1612.     delete $t->{twig_dtd};
  1613.     delete $t->{twig_in_pcdata};
  1614.     delete $t->{twig_in_cdata};
  1615.     delete $t->{twig_stored_space};
  1616.     delete $t->{twig_entity_list};
  1617.     $t->root->delete if( $t->root);
  1618.     delete $t->{root};
  1619.   }
  1620.  
  1621.  
  1622. sub _add_or_discard_stored_spaces
  1623.   { my $t= shift;
  1624.     my %option= @_;
  1625.    
  1626.     return unless( $t->{twig_current}); # ugly hack, with ignore twig_current can disappear 
  1627.     if( $t->{twig_stored_spaces} || $option{force} || $t->{twig_preserve_space})
  1628.       { if( $t->{twig_current}->is_pcdata)
  1629.           { $t->{twig_current}->append_pcdata($t->{twig_stored_spaces}); }
  1630.         else
  1631.           { my $current_gi= $t->{twig_current}->gi;
  1632.             unless( defined( $t->{twig_space_policy}->{$current_gi}))
  1633.               { $t->{twig_space_policy}->{$current_gi}= _space_policy( $t, $current_gi); }
  1634.  
  1635.             if(    $t->{twig_space_policy}->{$current_gi} ||  ($t->{twig_stored_spaces}!~ m{\n})
  1636.                 || $option{force} || $t->{twig_preserve_space}
  1637.               )
  1638.               { _insert_pcdata( $t, $t->{twig_stored_spaces} ); }
  1639.             $t->{twig_stored_spaces}='';
  1640.  
  1641.           }
  1642.       }
  1643.   }
  1644.  
  1645. # the default twig handlers, which build the tree
  1646. sub _twig_start
  1647.    { # warn " in _twig_start...\n"; # DEBUG handler
  1648.     
  1649.     my ($p, $gi, @att)= @_;
  1650.     my $t=$p->{twig};
  1651.  
  1652.     # empty the stored pcdata (space stored in case they are really part of 
  1653.     # a pcdata element) or stored it if the space policy dictades so
  1654.     # create a pcdata element with the spaces if need be
  1655.     _add_or_discard_stored_spaces( $t);
  1656.     my $parent= $t->{twig_current};
  1657.  
  1658.     # if we were parsing PCDATA then we exit the pcdata
  1659.     if( $t->{twig_in_pcdata})
  1660.       { $t->{twig_in_pcdata}= 0;
  1661.         delete $parent->{'twig_current'};
  1662.         $parent= $parent->{parent};
  1663.       }
  1664.  
  1665.     # if we choose to keep the encoding then we need to parse the tag
  1666.     if( my $func = $t->{parse_start_tag})
  1667.       { ($gi, @att)= &$func($p->original_string); }
  1668.     elsif( $t->{twig_entities_in_attribute})
  1669.       { 
  1670.        ($gi,@att)= _parse_start_tag( $p->recognized_string); 
  1671.          $t->{twig_entities_in_attribute}=0;
  1672.       }
  1673.  
  1674.     # if we are using an external DTD, we need to fill the default attributes
  1675.     if( $t->{twig_read_external_dtd}) { _fill_default_atts( $t, $gi, \@att); }
  1676.     
  1677.     # filter the input data if need be  
  1678.     if( my $filter= $t->{twig_input_filter})
  1679.       { $gi= $filter->( $gi);
  1680.         @att= map { $filter->($_) } @att; 
  1681.       }
  1682.  
  1683.     _replace_ns( $t, \$gi, \@att) if( $t->{twig_map_xmlns});
  1684.  
  1685.     my $elt= $t->{twig_elt_class}->new( $gi);
  1686.     $elt->set_atts( @att);
  1687.  
  1688.     # now we can store the tag and atts
  1689.     my $context= { _tag => $gi, _elt => $elt, @att};
  1690.     weaken( $context->{_elt}) if( $weakrefs);
  1691.     push @{$t->{_twig_context_stack}}, $context;
  1692.  
  1693.     delete $parent->{'twig_current'} if( $parent);
  1694.     $t->{twig_current}= $elt;
  1695.     $elt->{'twig_current'}=1;
  1696.  
  1697.     if( $parent)
  1698.       { my $prev_sibling= $parent->{last_child};
  1699.         if( $prev_sibling) 
  1700.           { $prev_sibling->{next_sibling}=  $elt; 
  1701.             $elt->set_prev_sibling( $prev_sibling);
  1702.           }
  1703.  
  1704.         $elt->set_parent( $parent);
  1705.         $parent->{first_child}=  $elt unless( $parent->{first_child}); 
  1706.         $parent->set_last_child( $elt);
  1707.       }
  1708.     else 
  1709.       { # processing root
  1710.         $t->set_root( $elt);
  1711.         # call dtd handler if need be
  1712.         $t->{twig_dtd_handler}->($t, $t->{twig_dtd})
  1713.           if( defined $t->{twig_dtd_handler});
  1714.       
  1715.         # set this so we can catch external entities
  1716.         # (the handler was modified during DTD processing)
  1717.         if( $t->{twig_default_print})
  1718.           { $p->setHandlers( Default => \&_twig_print); }
  1719.         elsif( $t->{twig_roots})
  1720.           { $p->setHandlers( Default => sub { return }); }
  1721.         else
  1722.           { $p->setHandlers( Default => \&_twig_default); }
  1723.       }
  1724.    
  1725.     $elt->{empty}=  $p->recognized_string=~ m{/\s*>$}s ? 1 : 0;
  1726.  
  1727.     $elt->{extra_data}= $t->{extra_data} if( $t->{extra_data});
  1728.     $t->{extra_data}='';
  1729.  
  1730.     # if the element is ID-ed then store that info
  1731.     my $id= $elt->{'att'}->{$ID};
  1732.     if( defined $id)
  1733.       { $t->{twig_id_list}->{$id}= $elt; 
  1734.         weaken( $t->{twig_id_list}->{$id}) if( $weakrefs);
  1735.       }
  1736.  
  1737.     # call user handler if need be
  1738.     if( $t->{twig_starttag_handlers})
  1739.       { # call all appropriate handlers
  1740.         my @handlers= _handler( $t, $t->{twig_starttag_handlers}, $gi, $elt);
  1741.     
  1742.         local $_= $elt;
  1743.     
  1744.         foreach my $handler ( @handlers)
  1745.           { $handler->($t, $elt) || last; }
  1746.         # call _all_ handler if needed
  1747.         if( my $all= $t->{twig_starttag_handlers}->{handlers}->{$ALL})
  1748.           { $all->($t, $elt); }
  1749.       }
  1750.  
  1751.     # check if the tag is in the list of tags to be ignored
  1752.     if( $t->{twig_ignore_elts_handlers})
  1753.       { my @handlers= _handler( $t, $t->{twig_ignore_elts_handlers}, $gi, $elt);
  1754.         # only the first handler counts, it contains the action (discard/print/string)
  1755.         if( @handlers) { my $action= shift @handlers; $t->ignore( $action); }
  1756.       }
  1757.  
  1758.     if( $elt->{'att'}->{'xml:space'} && (  $elt->{'att'}->{'xml:space'} eq 'preserve')) { $t->{twig_preserve_space}++; }
  1759.  
  1760.   }
  1761.  
  1762. sub _replace_ns
  1763.   { my( $t, $gi, $atts)= @_;
  1764.     foreach my $new_prefix ( $t->parser->new_ns_prefixes)
  1765.       { my $uri= $t->parser->expand_ns_prefix( $new_prefix);
  1766.         # replace the prefix if it is mapped
  1767.         if( !$t->{twig_keep_original_prefix} && (my $mapped_prefix= $t->{twig_map_xmlns}->{$uri}))
  1768.           { $new_prefix= $mapped_prefix; }
  1769.         # now put the namespace declaration back in the element
  1770.         if( $new_prefix eq '#default')
  1771.           { push @$atts, "xmlns" =>  $uri; } 
  1772.         else
  1773.           { push @$atts, "xmlns:$new_prefix" =>  $uri; } 
  1774.       }
  1775.  
  1776.     if( $t->{twig_keep_original_prefix})
  1777.       { # things become more complex: we need to find the original prefix
  1778.         # and store both prefixes
  1779.         my $ns_info= $t->_ns_info( $$gi);
  1780.         my $map_att;
  1781.         if( $ns_info->{mapped_prefix})
  1782.           { $$gi= "$ns_info->{mapped_prefix}:$$gi";
  1783.             $map_att->{$ns_info->{mapped_prefix}}= $ns_info->{prefix};
  1784.           }
  1785.         my $att_name=1;
  1786.         foreach( @$atts) 
  1787.           { if( $att_name) 
  1788.               { 
  1789.                 my $ns_info= $t->_ns_info( $_);
  1790.                 if( $ns_info->{mapped_prefix})
  1791.                   { $_= "$ns_info->{mapped_prefix}:$_";
  1792.                     $map_att->{$ns_info->{mapped_prefix}}= $ns_info->{prefix};
  1793.                   }
  1794.                 $att_name=0; 
  1795.               }
  1796.             else           
  1797.               {  $att_name=1; }
  1798.           }
  1799.         push @$atts, '#original_gi', $map_att if( $map_att);
  1800.       }
  1801.     else
  1802.       { $$gi= $t->_replace_prefix( $$gi); 
  1803.         my $att_name=1;
  1804.         foreach( @$atts) 
  1805.           { if( $att_name) { $_= $t->_replace_prefix( $_); $att_name=0; }
  1806.             else           {  $att_name=1; }
  1807.           }
  1808.       }
  1809.   }
  1810.  
  1811.  
  1812. # extract prefix, local_name, uri, mapped_prefix from a name
  1813. # will only work if called from a start or end tag handler
  1814. sub _ns_info
  1815.   { my( $t, $name)= @_;
  1816.     my $ns_info={};
  1817.     my $p= $t->parser;
  1818.     $ns_info->{uri}= $p->namespace( $name); 
  1819.     return $ns_info unless( $ns_info->{uri});
  1820.  
  1821.     $ns_info->{prefix}= _a_proper_ns_prefix( $p, $ns_info->{uri});
  1822.     $ns_info->{mapped_prefix}= $t->{twig_map_xmlns}->{$ns_info->{uri}} || $ns_info->{prefix};
  1823.  
  1824.     return $ns_info;
  1825.   }
  1826.     
  1827. sub _a_proper_ns_prefix
  1828.   { my( $p, $uri)= @_;
  1829.     foreach my $prefix ($p->current_ns_prefixes)
  1830.       { if( $p->expand_ns_prefix( $prefix) eq $uri)
  1831.           { return $prefix; }
  1832.       }
  1833.   }
  1834.  
  1835. sub _fill_default_atts
  1836.   { my( $t, $gi, $atts)= @_;
  1837.     my $dtd= $t->{twig_dtd};
  1838.     my $attlist= $dtd->{att}->{$gi};
  1839.     my %value= @$atts;
  1840.     foreach my $att (keys %$attlist)
  1841.       { if(   !exists( $value{$att}) 
  1842.             && exists( $attlist->{$att}->{default})
  1843.             && ( $attlist->{$att}->{default} ne '#IMPLIED')
  1844.           )
  1845.           { # the quotes are included in the default, so we need to remove them
  1846.             my $default_value= substr( $attlist->{$att}->{default}, 1, -1);
  1847.             push @$atts, $att, $default_value;
  1848.           }
  1849.       }
  1850.   }
  1851.  
  1852.  
  1853. # the default function to parse a start tag (in keep_encoding mode)
  1854. # can be overridden with the parse_start_tag method
  1855. # only works for 1-byte character sets
  1856. sub _parse_start_tag
  1857.   { my $string= shift;
  1858.     my( $gi, @atts);
  1859.  
  1860.     # get the gi (between < and the first space, / or > character)
  1861.     #if( $string=~ s{^<\s*([^\s>/]*)[\s>/]*}{}s)
  1862.     if( $string=~ s{^<\s*($REG_NAME)\s*[\s>/]}{}s)
  1863.       { $gi= $1; }
  1864.     else
  1865.       { croak "error parsing tag '$string'"; }
  1866.     while( $string=~ s{^([^\s=]*)\s*=\s*(["'])(.*?)\2\s*}{}s)
  1867.       { push @atts, $1, $3; }
  1868.     return $gi, @atts;
  1869.   }
  1870.  
  1871. sub set_root
  1872.   { my( $t, $elt)= @_;
  1873.     $t->{twig_root}= $elt;
  1874.     $elt->{twig}= $t;
  1875.     weaken(  $elt->{twig}) if( $weakrefs);
  1876.     return $t;
  1877.   }
  1878.  
  1879. sub _twig_end
  1880.    { # warn " in _twig_end...\n"; # DEBUG handler
  1881.     my ($p, $gi)  = @_;
  1882.  
  1883.     my $t=$p->{twig};
  1884.  
  1885.     if( $t->{twig_map_xmlns}) { $gi= $t->_replace_prefix( $gi); }
  1886.   
  1887.     _add_or_discard_stored_spaces( $t);
  1888.  
  1889.     # the new twig_current is the parent
  1890.     my $elt= $t->{twig_current};
  1891.     delete $elt->{'twig_current'};
  1892.  
  1893.     # if we were parsing PCDATA then we exit the pcdata too
  1894.     if( $t->{twig_in_pcdata})
  1895.       { $t->{twig_in_pcdata}= 0;
  1896.         $elt= $elt->{parent} if($elt->{parent});
  1897.         delete $elt->{'twig_current'};
  1898.       }
  1899.  
  1900.     # parent is the new current element
  1901.     my $parent= $elt->{parent};
  1902.     $parent->{'twig_current'}=1 if( $parent);
  1903.     $t->{twig_current}= $parent;
  1904.  
  1905.     # twig_to_be_normalized
  1906.     if( $parent->{twig_to_be_normalized}) { $parent->normalize; $parent->{twig_to_be_normalized}=0; }
  1907.  
  1908.     $elt->_set_extra_data_before_end_tag( $t->{extra_data}) if( $t->{extra_data}); 
  1909.     $t->{extra_data}='';
  1910.  
  1911.     if( $t->{twig_handlers})
  1912.       { # look for handlers
  1913.         my @handlers= _handler( $t, $t->{twig_handlers}, $gi, $elt);
  1914.         
  1915.         if( $t->{twig_tdh})
  1916.           { if( @handlers) { push @{$t->{twig_handlers_to_trigger}}, [ $elt, \@handlers ]; }
  1917.             if( my $all= $t->{twig_handlers}->{handlers}->{$ALL}) 
  1918.               { push @{$t->{twig_handlers_to_trigger}}, [ $elt, [$all] ]; }
  1919.           }
  1920.         else
  1921.           {
  1922.             local $_= $elt; # so we can use $_ in the handlers
  1923.     
  1924.             foreach my $handler ( @handlers)
  1925.               { $handler->($t, $elt) || last; }
  1926.             # call _all_ handler if needed
  1927.             if( my $all= $t->{twig_handlers}->{handlers}->{$ALL})
  1928.               { $all->($t, $elt); }
  1929.           }
  1930.       }
  1931.  
  1932.     # if twig_roots is set for the element then set appropriate handler
  1933.     if(  $t->{twig_root_depth} and ($p->depth == $t->{twig_root_depth}) )
  1934.       { if( $t->{twig_default_print})
  1935.           { # select the proper fh (and store the currently selected one)
  1936.             $t->_set_fh_to_twig_output_fh(); 
  1937.             if( $t->{twig_keep_encoding})
  1938.               { $p->setHandlers( %twig_handlers_roots_print_original); }
  1939.             else
  1940.               { $p->setHandlers( %twig_handlers_roots_print); }
  1941.           }
  1942.         else
  1943.           { $p->setHandlers( %twig_handlers_roots); }
  1944.       }
  1945.  
  1946.     if( $elt->{'att'}->{'xml:space'} && (  $elt->{'att'}->{'xml:space'} eq 'preserve')) { $t->{twig_preserve_space}--; }
  1947.  
  1948.     pop @{$t->{_twig_context_stack}};
  1949.   }
  1950.  
  1951. sub _trigger_tdh
  1952.   { my( $t)= @_;
  1953.  
  1954.     if( @{$t->{twig_handlers_to_trigger}})
  1955.       { my @handlers_to_trigger_now= sort { $a->[0]->cmp( $b->[0]) } @{$t->{twig_handlers_to_trigger}};
  1956.         foreach my $elt_handlers (@handlers_to_trigger_now)
  1957.           { my( $handled_elt, $handlers_to_trigger)= @$elt_handlers;
  1958.             foreach my $handler ( @$handlers_to_trigger) 
  1959.               { local $_= $handled_elt; $handler->($t, $handled_elt) || last; }
  1960.           }
  1961.       }
  1962.   }
  1963.  
  1964. # return the list of handler that can be activated for an element 
  1965. # (either of CODE ref's or 1's for twig_roots)
  1966.  
  1967. sub _handler
  1968.   { my( $t, $handlers, $gi, $elt)= @_;
  1969.  
  1970.     my @found_handlers=();
  1971.     my $found_handler;
  1972.  
  1973.     # warning: $elt can be either 
  1974.     # - a regular element
  1975.     # - a ref to the attribute hash (when called for an element 
  1976.     #   for which the XML::Twig::Elt has not been built, outside 
  1977.     #   of the twig_roots)
  1978.     # - a string (case of an entity in keep_encoding mode)
  1979.  
  1980.     foreach my $handler ( map { @$_ } grep { $_ } $handlers->{xpath_handler}->{$gi}, $handlers->{xpath_handler}->{'*'})
  1981.       {  my $trigger= $handler->{trigger};
  1982.          if( my $found_path= $trigger->( $t->{_twig_context_stack}))
  1983.           { my $found_handler= $handler->{handler};
  1984.             push @found_handlers, $found_handler; 
  1985.           }
  1986.       }
  1987.  
  1988.     # if no handler found call default handler if defined
  1989.     if( !@found_handlers && defined $handlers->{handlers}->{$DEFAULT})
  1990.       { push @found_handlers, $handlers->{handlers}->{$DEFAULT}; }
  1991.  
  1992.     if( @found_handlers and $t->{twig_do_not_chain_handlers}) 
  1993.       { @found_handlers= ($found_handlers[0]); }
  1994.  
  1995.     return @found_handlers; # empty if no handler found
  1996.  
  1997.   }
  1998.  
  1999.  
  2000. sub _replace_prefix
  2001.   { my( $t, $name)= @_;
  2002.     my $p= $t->parser;
  2003.     my $uri= $p->namespace( $name);
  2004.     # try to get the namespace from default if none is found (for attributes)
  2005.     # this should probably be an option
  2006.     if( !$uri and( $name!~/^xml/)) { $uri= $p->expand_ns_prefix( '#default'); }
  2007.     if( $uri)
  2008.       { if (my $mapped_prefix= $t->{twig_map_xmlns}->{$uri})
  2009.           { return "$mapped_prefix:$name"; }
  2010.         else
  2011.           { my $prefix= _a_proper_ns_prefix( $p, $uri);
  2012.             if( $prefix eq '#default') { $prefix=''; }
  2013.             return $prefix ? "$prefix:$name" : $name; 
  2014.           }
  2015.       }
  2016.     else
  2017.       { return $name; }
  2018.   }
  2019.  
  2020. sub _twig_char
  2021.    { # warn " in _twig_char...\n"; # DEBUG handler
  2022.     
  2023.     my ($p, $string)= @_;
  2024.     my $t=$p->{twig}; 
  2025.  
  2026.     if( $t->{twig_keep_encoding})
  2027.       { if( !$t->{twig_in_cdata})
  2028.           { $string= $p->original_string(); }
  2029.         else
  2030.           { 
  2031.             use bytes; # > perl 5.5
  2032.             if( length( $string) < 1024)
  2033.               { $string= $p->original_string(); }
  2034.             else
  2035.               { #warn "dodgy case";
  2036.                 # TODO original_string does not hold the entire string, but $string is wrong
  2037.                 # I believe due to a bug in XML::Parser
  2038.               }
  2039.           }
  2040.       }
  2041.  
  2042.     if( $t->{twig_input_filter})
  2043.       { $string= $t->{twig_input_filter}->( $string); }
  2044.  
  2045.     if( $t->{twig_char_handler})
  2046.       { $string= $t->{twig_char_handler}->( $string); }
  2047.  
  2048.     my $elt= $t->{twig_current};
  2049.  
  2050.     if(    $t->{twig_in_cdata})
  2051.       { # text is the continuation of a previously created cdata
  2052.         $elt->{cdata}.=  $t->{twig_stored_spaces} . $string;
  2053.       } 
  2054.     elsif( $t->{twig_in_pcdata})
  2055.       { # text is the continuation of a previously created cdata
  2056.         if( $t->{extra_data})
  2057.           { $elt->_push_extra_data_in_pcdata( $t->{extra_data}, length( $elt->{pcdata}));
  2058.             $t->{extra_data}='';
  2059.           }
  2060.         $elt->{pcdata}.=  $string; 
  2061.       } 
  2062.     else
  2063.       { # text is just space, which might be discarded later
  2064.         if( $string=~/\A\s*\Z/s)
  2065.           { if( $t->{extra_data})
  2066.               { # we got extra data (comment, pi), lets add the spaces to it
  2067.                 $t->{extra_data} .= $string; 
  2068.               }
  2069.             else
  2070.               { # no extra data, just store the spaces
  2071.                 $t->{twig_stored_spaces}.= $string;
  2072.               }
  2073.           } 
  2074.         else
  2075.           { my $new_elt= _insert_pcdata( $t, $t->{twig_stored_spaces}.$string);
  2076.             delete $elt->{'twig_current'};
  2077.             $new_elt->{'twig_current'}=1;
  2078.             $t->{twig_current}= $new_elt;
  2079.             $t->{twig_in_pcdata}=1;
  2080.             if( $t->{extra_data})
  2081.               { $new_elt->_push_extra_data_in_pcdata( $t->{extra_data}, 0);
  2082.                 $t->{extra_data}='';
  2083.               }
  2084.           }
  2085.       }
  2086.   }
  2087.  
  2088. sub _twig_cdatastart
  2089.    { # warn " in _twig_cdatastart...\n"; # DEBUG handler
  2090.     
  2091.     my $p= shift;
  2092.     my $t=$p->{twig};
  2093.  
  2094.     $t->{twig_in_cdata}=1;
  2095.     my $cdata=  $t->{twig_elt_class}->new( '#CDATA');
  2096.     my $twig_current= $t->{twig_current};
  2097.  
  2098.     if( $t->{twig_in_pcdata})
  2099.       { # create the node as a sibling of the #PCDATA
  2100.         $cdata->set_prev_sibling( $twig_current);
  2101.         $twig_current->{next_sibling}=  $cdata;
  2102.         my $parent= $twig_current->{parent};
  2103.         $cdata->set_parent( $parent);
  2104.         $parent->set_last_child( $cdata);
  2105.         $t->{twig_in_pcdata}=0;
  2106.       }
  2107.     else
  2108.       { # we have to create a PCDATA element if we need to store spaces
  2109.         if( $t->_space_policy($XML::Twig::index2gi[$twig_current->{'gi'}]) && $t->{twig_stored_spaces})
  2110.           { _insert_pcdata( $t, $t->{twig_stored_spaces}); }
  2111.         $t->{twig_stored_spaces}='';
  2112.       
  2113.         # create the node as a child of the current element      
  2114.         $cdata->set_parent( $twig_current);
  2115.         if( my $prev_sibling= $twig_current->{last_child})
  2116.           { $cdata->set_prev_sibling( $prev_sibling);
  2117.             $prev_sibling->{next_sibling}=  $cdata;
  2118.           }
  2119.         else
  2120.           { $twig_current->{first_child}=  $cdata; }
  2121.         $twig_current->set_last_child( $cdata);
  2122.       
  2123.       }
  2124.  
  2125.     delete $twig_current->{'twig_current'};
  2126.     $t->{twig_current}= $cdata;
  2127.     $cdata->{'twig_current'}=1;
  2128.     if( $t->{extra_data}) { $cdata->set_extra_data( $t->{extra_data}); $t->{extra_data}='' };
  2129.   }
  2130.  
  2131. sub _twig_cdataend
  2132.    { # warn " in _twig_cdataend...\n"; # DEBUG handler
  2133.     
  2134.     my $p= shift;
  2135.     my $t=$p->{twig};
  2136.  
  2137.     $t->{twig_in_cdata}=0;
  2138.  
  2139.     my $elt= $t->{twig_current};
  2140.     delete $elt->{'twig_current'};
  2141.     my $cdata= $elt->{cdata};
  2142.     $elt->_set_cdata( $cdata);
  2143.  
  2144.     push @{$t->{_twig_context_stack}}, { _tag => '#CDATA' };
  2145.  
  2146.     if( $t->{twig_handlers})
  2147.       { # look for handlers
  2148.         my @handlers= _handler( $t, $t->{twig_handlers}, CDATA, $elt);
  2149.         local $_= $elt; # so we can use $_ in the handlers
  2150.         foreach my $handler ( @handlers) { $handler->($t, $elt) || last; }
  2151.       }
  2152.  
  2153.     pop @{$t->{_twig_context_stack}};
  2154.  
  2155.     $elt= $elt->{parent};
  2156.     $t->{twig_current}= $elt;
  2157.     $elt->{'twig_current'}=1;
  2158.  
  2159.     $t->{twig_long_cdata}=0;
  2160.   }
  2161.  
  2162. sub _pi_elt_handlers
  2163.   { my( $t, $pi)= @_;
  2164.     my $pi_handlers= $t->{twig_handlers}->{pi_handlers} || return;
  2165.     foreach my $handler ( $pi_handlers->{$pi->{target}}, $pi_handlers->{''})
  2166.       { if( $handler) { local $_= $pi; $handler->( $t, $pi) || last; } }
  2167.   }
  2168.  
  2169. sub _pi_text_handler
  2170.   { my( $t, $target, $data)= @_;
  2171.     if( my $handler= $t->{twig_handlers}->{pi_handlers}->{$target})
  2172.       { return $handler->( $t, $target, $data); }
  2173.     if( my $handler= $t->{twig_handlers}->{pi_handlers}->{''})
  2174.       { return $handler->( $t, $target, $data); }
  2175.     return defined( $data) && $data ne ''  ? "<?$target $data?>" : "<?$target?>" ;
  2176.   }
  2177.  
  2178. sub _comment_elt_handler
  2179.   { my( $t, $comment)= @_; 
  2180.     if( my $handler= $t->{twig_handlers}->{handlers}->{'#COMMENT'})
  2181.       { local $_= $comment; $handler->($t, $comment); }
  2182.   }
  2183.  
  2184. sub _comment_text_handler
  2185.   { my( $t, $comment)= @_; 
  2186.     if( my $handler= $t->{twig_handlers}->{handlers}->{'#COMMENT'})
  2187.       { $comment= $handler->($t, $comment); 
  2188.         if( !defined $comment || $comment eq '') { return ''; }
  2189.       }
  2190.     return "<!--$comment-->";
  2191.   }
  2192.  
  2193.  
  2194.  
  2195. sub _twig_comment
  2196.    { # warn " in _twig_comment...\n"; # DEBUG handler
  2197.     
  2198.     my( $p, $comment_text)= @_;
  2199.     my $t=$p->{twig};
  2200.  
  2201.     if( $t->{twig_keep_encoding}) { $comment_text= substr( $p->original_string(), 4, -3); }
  2202.     
  2203.     $t->_twig_pi_comment( $p, '#COMMENT', $t->{twig_keep_comments}, $t->{twig_process_comments},
  2204.                           '_set_comment', '_comment_elt_handler', '_comment_text_handler', $comment_text
  2205.                         );
  2206.   }
  2207.  
  2208. sub _twig_pi
  2209.    { # warn " in _twig_pi...\n"; # DEBUG handler
  2210.     
  2211.     my( $p, $target, $data)= @_;
  2212.     my $t=$p->{twig};
  2213.  
  2214.     if( $t->{twig_keep_encoding}) 
  2215.       { my $pi_text= substr( $p->original_string(), 2, -2); 
  2216.         ($target, $data)= split( /\s+/, $pi_text, 2);
  2217.       }
  2218.  
  2219.     $t->_twig_pi_comment( $p, '#PI', $t->{twig_keep_pi}, $t->{twig_process_pi},
  2220.                           '_set_pi', '_pi_elt_handlers', '_pi_text_handler', $target, $data
  2221.                         );
  2222.   }
  2223.  
  2224. sub _twig_pi_comment
  2225.   { my( $t, $p, $type, $keep, $process, $set, $elt_handler, $text_handler, @parser_args)= @_;
  2226.  
  2227.     if( $t->{twig_input_filter})
  2228.           { foreach my $arg (@parser_args) { $arg= $t->{twig_input_filter}->( $arg); } }
  2229.           
  2230.     # if pi/comments are to be kept then we piggiback them to the current element
  2231.     if( $keep)
  2232.       { # first add spaces
  2233.         if( $t->{twig_stored_spaces})
  2234.               { $t->{extra_data}.= $t->{twig_stored_spaces};
  2235.                 $t->{twig_stored_spaces}= '';
  2236.               }
  2237.  
  2238.         my $extra_data= $t->$text_handler( @parser_args);
  2239.         $t->{extra_data}.= $extra_data;
  2240.  
  2241.       }
  2242.     elsif( $process)
  2243.       {
  2244.         my $twig_current= $t->{twig_current}; # defined unless we are outside of the root
  2245.  
  2246.         my $elt= $t->{twig_elt_class}->new( $type);
  2247.         $elt->$set( @parser_args);
  2248.         if( $t->{extra_data}) 
  2249.           { $elt->set_extra_data( $t->{extra_data});
  2250.             $t->{extra_data}='';
  2251.           }
  2252.  
  2253.         unless( $t->root) 
  2254.           { $t->_add_cpi_outside_of_root( leading_cpi => $elt);
  2255.           }
  2256.         elsif( $t->{twig_in_pcdata})
  2257.           { # create the node as a sibling of the #PCDATA
  2258.             $elt->paste_after( $twig_current);
  2259.             $t->{twig_in_pcdata}=0;
  2260.           }
  2261.         elsif( $twig_current)
  2262.           { # we have to create a PCDATA element if we need to store spaces
  2263.             if( $t->_space_policy($XML::Twig::index2gi[$twig_current->{'gi'}]) && $t->{twig_stored_spaces})
  2264.               { _insert_pcdata( $t, $t->{twig_stored_spaces}); }
  2265.             $t->{twig_stored_spaces}='';
  2266.             # create the node as a child of the current element
  2267.             $elt->paste_last_child( $twig_current);
  2268.           }
  2269.         else
  2270.           { $t->_add_cpi_outside_of_root( trailing_cpi => $elt); }
  2271.  
  2272.         if( $twig_current)
  2273.           { delete $twig_current->{'twig_current'};
  2274.             my $parent= $elt->{parent};
  2275.             $t->{twig_current}= $parent;
  2276.             $parent->{'twig_current'}=1;
  2277.           }
  2278.  
  2279.         $t->$elt_handler( $elt);
  2280.       }
  2281.  
  2282.   }
  2283.     
  2284.  
  2285. # add a comment or pi before the first element
  2286. sub _add_cpi_outside_of_root
  2287.   { my($t, $type, $elt)= @_; # $type is 'leading_cpi' or 'trailing_cpi'
  2288.     $t->{$type} ||= $t->{twig_elt_class}->new( '#CPI');
  2289.     # create the node as a child of the current element
  2290.     $elt->paste_last_child( $t->{$type});
  2291.     return $t;
  2292.   }
  2293.   
  2294. sub _twig_final
  2295.    { # warn " in _twig_final...\n"; # DEBUG handler
  2296.     
  2297.     my $p= shift;
  2298.     my $t= $p->isa( 'XML::Twig') ? $p : $p->{twig};
  2299.  
  2300.     # store trailing data
  2301.     if( $t->{extra_data}) { $t->{trailing_cpi_text}= $t->{extra_data}; $t->{extra_data}=''; }
  2302.  
  2303.     # restore the selected filehandle if needed
  2304.     $t->_set_fh_to_selected_fh();
  2305.  
  2306.     $t->_trigger_tdh if( $t->{twig_tdh});
  2307.  
  2308.     select $t->{twig_original_selected_fh} if($t->{twig_original_selected_fh}); # probably dodgy
  2309.  
  2310.     if( exists $t->{twig_autoflush_data})
  2311.       { my @args;
  2312.         push @args,  $t->{twig_autoflush_data}->{fh}      if( $t->{twig_autoflush_data}->{fh});
  2313.         push @args,  @{$t->{twig_autoflush_data}->{args}} if( $t->{twig_autoflush_data}->{args});
  2314.         $t->flush( @args);
  2315.         delete $t->{twig_autoflush_data};
  2316.         $t->root->delete;
  2317.       }
  2318.  
  2319.     # tries to clean-up (probably not very well at the moment)
  2320.     #undef $p->{twig};
  2321.     undef $t->{twig_parser};
  2322.     delete $t->{twig_parsing};
  2323.     @{$t}{ qw( twig_parser twig_parsing _twig_context_stack twig_current) }=();
  2324.  
  2325.     return $t;
  2326.   }
  2327.  
  2328. sub _insert_pcdata
  2329.   { my( $t, $string)= @_;
  2330.     # create a new #PCDATA element
  2331.     my $parent= $t->{twig_current};    # always defined
  2332.     my $elt=  $t->{twig_elt_class}->new( PCDATA);
  2333.     $elt->_set_pcdata( $string);
  2334.     my $prev_sibling= $parent->{last_child};
  2335.     if( $prev_sibling) 
  2336.       { $prev_sibling->{next_sibling}=  $elt; 
  2337.         $elt->set_prev_sibling( $prev_sibling);
  2338.       }
  2339.     else
  2340.       { $parent->{first_child}=  $elt; }
  2341.  
  2342.     $elt->set_parent( $parent);
  2343.     $parent->set_last_child( $elt);
  2344.     $t->{twig_stored_spaces}='';
  2345.     return $elt;
  2346.   }
  2347.  
  2348. sub _space_policy
  2349.   { my( $t, $gi)= @_;
  2350.     my $policy;
  2351.     $policy=0 if( $t->{twig_discard_spaces});
  2352.     $policy=1 if( $t->{twig_keep_spaces});
  2353.     $policy=1 if( $t->{twig_keep_spaces_in}
  2354.                && $t->{twig_keep_spaces_in}->{$gi});
  2355.     $policy=0 if( $t->{twig_discard_spaces_in} 
  2356.                && $t->{twig_discard_spaces_in}->{$gi});
  2357.     return $policy;
  2358.   }
  2359.  
  2360.  
  2361. sub _twig_entity($$$$$$)
  2362.    { # warn " in _twig_entity...\n"; # DEBUG handler
  2363.     
  2364.     my( $p, $name, $val, $sysid, $pubid, $ndata, $param)= @_;
  2365.     my $t=$p->{twig};
  2366.  
  2367.     #{ no warnings; my $base= $p->base; warn "_twig_entity called: expand: '$t->{twig_expand_external_ents}', base: '$base', name: '$name', val: '$val', sysid: '$sysid', pubid: '$pubid', ndata: '$ndata', param: '$param'\n";}
  2368.  
  2369.     my $missing_entity=0;
  2370.  
  2371.     if( $sysid) 
  2372.       { if($ndata)
  2373.           { if( ! -f _based_filename( $sysid, $p->base)) { $missing_entity= 1; }
  2374.           }
  2375.         else
  2376.           { if( $t->{twig_expand_external_ents})
  2377.               { $val= eval { _slurp_uri( $sysid, $p->base) };
  2378.                 if( ! defined $val) 
  2379.                   { if( $t->{twig_extern_ent_nofail}) 
  2380.                       { $missing_entity= 1; }
  2381.                     else
  2382.                       { _croak( "cannot load SYSTEM entity '$name' from '$sysid': $@", 3); }
  2383.                   }
  2384.               }
  2385.           }
  2386.       }
  2387.  
  2388.     my $ent=XML::Twig::Entity->new( $name, $val, $sysid, $pubid, $ndata, $param);
  2389.     if( $missing_entity) { $t->{twig_missing_system_entities}->{$name}= $ent; }
  2390.  
  2391.     my $entity_list= $t->entity_list;
  2392.     if( $entity_list) { $entity_list->add( $ent); }
  2393.  
  2394.     if( $parser_version > 2.27) 
  2395.       { # this is really ugly, but with some versions of XML::Parser the value 
  2396.         # of the entity is not properly returned by the default handler
  2397.         my $ent_decl= $ent->text;
  2398.         if( $t->{twig_keep_encoding})
  2399.           { if( defined $ent->{val} && ($ent_decl !~ /["']/))
  2400.               { my $val=  $ent->{val};
  2401.                 $ent_decl .= $val =~ /"/ ? qq{'$val' } : qq{"$val" }; 
  2402.               }
  2403.             # for my solaris box (perl 5.6.1, XML::Parser 2.31, expat?)
  2404.             $t->{twig_doctype}->{internal}=~ s{<!ENTITY\s+$name\s+$}{substr( $ent_decl, 0, -1)}e;
  2405.           }
  2406.         $t->{twig_doctype}->{internal} .= $ent_decl 
  2407.           unless( $t->{twig_doctype}->{internal}=~ m{<!ENTITY\s+$name\s+});
  2408.       }
  2409.  
  2410.   }
  2411.  
  2412.  
  2413. sub _twig_extern_ent
  2414.    { # warn " in _twig_extern_ent...I (", $_[0]->original_string, ")\n"; # DEBUG handler
  2415.     my( $p, $base, $sysid, $pubid)= @_;
  2416.     my $t= $p->{twig};
  2417.     if( $t->{twig_no_expand}) 
  2418.       { my $ent_name= $t->{twig_keep_encoding} ? $p->original_string : $p->recognized_string;
  2419.         _twig_insert_ent( $t, $ent_name);
  2420.         return '';
  2421.       }
  2422.     my $ent_content= eval { $t->{twig_ext_ent_handler}->( $p, $base, $sysid) };
  2423.     if( ! defined $ent_content)
  2424.       { 
  2425.         my $ent_name = $p->recognized_string;
  2426.         my $file     =  _based_filename( $sysid, $base);
  2427.         my $error_message= "cannot expand $ent_name - cannot load '$file'";
  2428.         if( $t->{twig_extern_ent_nofail}) { return "<!-- $error_message -->"; }
  2429.         else                              { _croak( $error_message);   }
  2430.       }
  2431.     return $ent_content; 
  2432.   }
  2433.  
  2434. # I use this so I can change the $Carp::CarpLevel (which determines how many call frames to skip when reporting an error)
  2435. sub _croak
  2436.   { my( $message, $level)= @_;
  2437.     $Carp::CarpLevel= $level || 0;
  2438.     croak $message;
  2439.   }
  2440.  
  2441. sub _twig_xmldecl
  2442.    { # warn " in _twig_xmldecl...\n"; # DEBUG handler
  2443.     
  2444.     my $p= shift;
  2445.     my $t=$p->{twig};
  2446.     $t->{twig_xmldecl}||={};                 # could have been set by set_output_encoding
  2447.     $t->{twig_xmldecl}->{version}= shift;
  2448.     $t->{twig_xmldecl}->{encoding}= shift; 
  2449.     $t->{twig_xmldecl}->{standalone}= shift;
  2450.   }
  2451.  
  2452. sub _twig_doctype
  2453.    { # warn " in _twig_doctype...\n"; # DEBUG handler
  2454.     my( $p, $name, $sysid, $pub, $internal)= @_;
  2455.     my $t=$p->{twig};
  2456.     $t->{twig_doctype}||= {};                   # create 
  2457.     $t->{twig_doctype}->{name}= $name;          # always there
  2458.     $t->{twig_doctype}->{sysid}= $sysid;        #  
  2459.     $t->{twig_doctype}->{pub}= $pub;            #  
  2460.  
  2461.     # now let's try to cope with XML::Parser 2.28 and above
  2462.     if( $parser_version > 2.27)
  2463.       { @saved_default_handler= $p->setHandlers( Default     => \&_twig_store_internal_dtd,
  2464.                                                  Entity      => \&_twig_entity,
  2465.                                                );
  2466.       $p->setHandlers( DoctypeFin  => \&_twig_stop_storing_internal_dtd);
  2467.       $t->{twig_doctype}->{internal}='';
  2468.       }
  2469.     else            
  2470.       # for XML::Parser before 2.28
  2471.       { $internal||='';
  2472.         $internal=~ s{^\s*\[}{}; 
  2473.         $internal=~ s{]\s*$}{}; 
  2474.         $t->{twig_doctype}->{internal}=$internal; 
  2475.       }
  2476.  
  2477.     # now check if we want to get the DTD info
  2478.     if( $t->{twig_read_external_dtd} && $sysid)
  2479.       { # let's build a fake document with an internal DTD
  2480.         my $dtd=  "<!DOCTYPE $name [" . _slurp_uri( $sysid) .  "]><$name/>";
  2481.        
  2482.         $t->save_global_state();            # save the globals (they will be reset by the following new)  
  2483.         my $t_dtd= XML::Twig->new( error_context => $t->{ErrorContext} || 0);          # create a temp twig
  2484.         $t_dtd->parse( $dtd);               # parse it
  2485.         $t->{twig_dtd}= $t_dtd->{twig_dtd}; # grab the dtd info
  2486.         #$t->{twig_dtd_is_external}=1;
  2487.         $t->entity_list->_add_list( $t_dtd->entity_list) if( $t_dtd->entity_list); # grab the entity info
  2488.         $t->restore_global_state();
  2489.       }
  2490.  
  2491.   }
  2492.  
  2493. sub _twig_element
  2494.    { # warn " in _twig_element...\n"; # DEBUG handler
  2495.     
  2496.     my( $p, $name, $model)= @_;
  2497.     my $t=$p->{twig};
  2498.     $t->{twig_dtd}||= {};                      # may create the dtd 
  2499.     $t->{twig_dtd}->{model}||= {};             # may create the model hash 
  2500.     $t->{twig_dtd}->{elt_list}||= [];          # ordered list of elements 
  2501.     push @{$t->{twig_dtd}->{elt_list}}, $name; # store the elt
  2502.     $t->{twig_dtd}->{model}->{$name}= $model;  # store the model
  2503.     if( ($parser_version > 2.27) && ($t->{twig_doctype}->{internal}=~ m{(^|>)\s*$}) ) 
  2504.       { my $text= $XML::Twig::Elt::keep_encoding ? $p->original_string : $p->recognized_string; 
  2505.         unless( $text)
  2506.           { # this version of XML::Parser does not return the text in the *_string method
  2507.             # we need to rebuild it
  2508.             $text= "<!ELEMENT $name $model>";
  2509.           }
  2510.         $t->{twig_doctype}->{internal} .= $text;
  2511.       }
  2512.   }
  2513.  
  2514. sub _twig_attlist
  2515.    { # warn " in _twig_attlist...\n"; # DEBUG handler
  2516.     
  2517.     my( $p, $gi, $att, $type, $default, $fixed)= @_;
  2518.     #warn "in attlist: gi: '$gi', att: '$att', type: '$type', default: '$default', fixed: '$fixed'\n";
  2519.     my $t=$p->{twig};
  2520.     $t->{twig_dtd}||= {};                      # create dtd if need be 
  2521.     $t->{twig_dtd}->{$gi}||= {};               # create elt if need be 
  2522.     #$t->{twig_dtd}->{$gi}->{att}||= {};        # create att if need be 
  2523.     if( ($parser_version > 2.27) && ($t->{twig_doctype}->{internal}=~ m{(^|>)\s*$}) ) 
  2524.       { my $text= $XML::Twig::Elt::keep_encoding ? $p->original_string : $p->recognized_string; 
  2525.         unless( $text)
  2526.           { # this version of XML::Parser does not return the text in the *_string method
  2527.             # we need to rebuild it
  2528.             my $att_decl="$att $type";
  2529.             $att_decl .= " #FIXED"   if( $fixed);
  2530.             $att_decl .= " $default" if( defined $default);
  2531.             # 2 cases: there is already an attlist on that element or not
  2532.             if( $t->{twig_dtd}->{att}->{$gi})
  2533.               { # there is already an attlist, add to it
  2534.                 $t->{twig_doctype}->{internal}=~ s{(<!ATTLIST\s*$gi )(.*?)\n?>}
  2535.                                                   { "$1$2\n" . ' ' x length( $1) . "$att_decl\n>"}es;
  2536.               }
  2537.             else
  2538.               { # create the attlist
  2539.                  $t->{twig_doctype}->{internal}.= "<!ATTLIST $gi $att_decl>"
  2540.               }
  2541.           }
  2542.       }
  2543.     $t->{twig_dtd}->{att}->{$gi}->{$att}= {} ;
  2544.     $t->{twig_dtd}->{att}->{$gi}->{$att}->{type}= $type; 
  2545.     $t->{twig_dtd}->{att}->{$gi}->{$att}->{default}= $default if( defined $default);
  2546.     $t->{twig_dtd}->{att}->{$gi}->{$att}->{fixed}= $fixed; 
  2547.   }
  2548.  
  2549. sub _twig_default
  2550.    { # warn " in _twig_default...\n"; # DEBUG handler
  2551.     
  2552.     my( $p, $string)= @_;
  2553.     
  2554.     my $t= $p->{twig};
  2555.     
  2556.     # process only if we have an entity
  2557.     return unless( $string=~ m{^&([^;]*);$});
  2558.     # the entity has to be pure pcdata, or we have a problem
  2559.     if( ($p->original_string=~ m{^<}) && ($p->original_string=~ m{>$}) ) 
  2560.       { # string is a tag, entity is in an attribute
  2561.         $t->{twig_entities_in_attribute}=1 if( $t->{twig_do_not_escape_amp_in_atts});
  2562.       }
  2563.     else
  2564.       { my $ent;
  2565.         if( $t->{twig_keep_encoding}) 
  2566.           { _twig_char( $p, $string); 
  2567.             $ent= substr( $string, 1, -1);
  2568.           }
  2569.         else
  2570.           { $ent= _twig_insert_ent( $t, $string); 
  2571.           }
  2572.  
  2573.         return $ent;
  2574.       }
  2575.   }
  2576.     
  2577. sub _twig_insert_ent
  2578.   { 
  2579.     my( $t, $string)=@_;
  2580.  
  2581.     my $twig_current= $t->{twig_current};
  2582.  
  2583.     my $ent=  $t->{twig_elt_class}->new( '#ENT');
  2584.     $ent->{ent}=  $string;
  2585.  
  2586.     _add_or_discard_stored_spaces( $t, force => 0);
  2587.     
  2588.     if( $t->{twig_in_pcdata})
  2589.       { # create the node as a sibling of the #PCDATA
  2590.  
  2591.         $ent->set_prev_sibling( $twig_current);
  2592.         $twig_current->{next_sibling}=  $ent;
  2593.         my $parent= $twig_current->{parent};
  2594.         $ent->set_parent( $parent);
  2595.         $parent->set_last_child( $ent);
  2596.         # the twig_current is now the parent
  2597.         delete $twig_current->{'twig_current'};
  2598.         $t->{twig_current}= $parent;
  2599.         # we left pcdata
  2600.         $t->{twig_in_pcdata}=0;
  2601.       }
  2602.     else
  2603.       { # create the node as a child of the current element
  2604.         $ent->set_parent( $twig_current);
  2605.         if( my $prev_sibling= $twig_current->{last_child})
  2606.           { $ent->set_prev_sibling( $prev_sibling);
  2607.             $prev_sibling->{next_sibling}=  $ent;
  2608.           }
  2609.         else
  2610.           { $twig_current->{first_child}=  $ent if( $twig_current); }
  2611.         $twig_current->set_last_child( $ent) if( $twig_current);
  2612.       }
  2613.  
  2614.     # meant to trigger entity handler, does not seem to be activated at this time
  2615.     #if( my $handler= $t->{twig_handlers}->{gi}->{'#ENT'})
  2616.     #  { local $_= $ent; $handler->( $t, $ent); }
  2617.  
  2618.     return $ent;
  2619.   }
  2620.  
  2621. sub parser
  2622.   { return $_[0]->{twig_parser}; }
  2623.  
  2624. # returns the declaration text (or a default one)
  2625. sub xmldecl
  2626.   { my $t= shift;
  2627.     return '' unless( $t->{twig_xmldecl} || $t->{output_encoding});
  2628.     my $decl_string;
  2629.     my $decl= $t->{twig_xmldecl};
  2630.     if( $decl)
  2631.       { my $version= $decl->{version};
  2632.         $decl_string= q{<?xml};
  2633.         $decl_string .= qq{ version="$version"};
  2634.  
  2635.         # encoding can either have been set (in $decl->{output_encoding})
  2636.         # or come from the document (in $decl->{encoding})
  2637.         if( $t->{output_encoding})
  2638.           { my $encoding= $t->{output_encoding};
  2639.             $decl_string .= qq{ encoding="$encoding"};
  2640.           }
  2641.         elsif( $decl->{encoding})
  2642.           { my $encoding= $decl->{encoding};
  2643.             $decl_string .= qq{ encoding="$encoding"};
  2644.           }
  2645.     
  2646.         if( defined( $decl->{standalone}))
  2647.           { $decl_string .= q{ standalone="};  
  2648.             $decl_string .= $decl->{standalone} ? "yes" : "no";  
  2649.             $decl_string .= q{"}; 
  2650.           }
  2651.       
  2652.         $decl_string .= "?>\n";
  2653.       }
  2654.     else
  2655.       { my $encoding= $t->{output_encoding};
  2656.         $decl_string= qq{<?xml version="1.0" encoding="$encoding"?>};
  2657.       }
  2658.       
  2659.     my $output_filter= XML::Twig::Elt::output_filter();
  2660.     return $output_filter ? $output_filter->( $decl_string) : $decl_string;
  2661.   }
  2662.  
  2663. sub set_doctype
  2664.   { my( $t, $name, $system, $public, $internal)= @_;
  2665.     $t->{twig_doctype}= {} unless defined $t->{twig_doctype};
  2666.     my $doctype= $t->{twig_doctype};
  2667.     $doctype->{name}     = $name     if( defined $name);
  2668.     $doctype->{sysid}    = $system   if( defined $system);
  2669.     $doctype->{pub}      = $public   if( defined $public);
  2670.     $doctype->{internal} = $internal if( defined $internal);
  2671.   }
  2672.  
  2673. sub doctype_name
  2674.   { my $t= shift;
  2675.     my $doctype= $t->{twig_doctype} or return '';
  2676.     return $doctype->{name} || '';
  2677.   }
  2678.  
  2679. sub system_id
  2680.   { my $t= shift;
  2681.     my $doctype= $t->{twig_doctype} or return '';
  2682.     return $doctype->{sysid} || '';
  2683.   }
  2684.  
  2685. sub public_id
  2686.   { my $t= shift;
  2687.     my $doctype= $t->{twig_doctype} or return '';
  2688.     return $doctype->{pub} || '';
  2689.   }
  2690.  
  2691. sub internal_subset
  2692.   { my $t= shift;
  2693.     my $doctype= $t->{twig_doctype} or return '';
  2694.     return $doctype->{internal} || '';
  2695.   }
  2696.  
  2697. # return the dtd object
  2698. sub dtd
  2699.   { my $t= shift;
  2700.     return $t->{twig_dtd};
  2701.   }
  2702.  
  2703. # return an element model, or the list of element models
  2704. sub model
  2705.   { my $t= shift;
  2706.     my $elt= shift;
  2707.     return $t->dtd->{model}->{$elt} if( $elt);
  2708.     return sort keys %{$t->dtd->{model}};
  2709.   }
  2710.  
  2711.         
  2712. # return the entity_list object 
  2713. sub entity_list($)
  2714.   { my $t= shift;
  2715.     return $t->{twig_entity_list};
  2716.   }
  2717.  
  2718. # return the list of entity names 
  2719. sub entity_names($)
  2720.   { my $t= shift;
  2721.     return $t->entity_list->entity_names;
  2722.   }
  2723.  
  2724. # return the entity object 
  2725. sub entity($$)
  2726.   { my $t= shift;
  2727.     my $entity_name= shift;
  2728.     return $t->entity_list->ent( $entity_name);
  2729.   }
  2730.  
  2731.  
  2732. sub print_prolog
  2733.   { my $t= shift;
  2734.     my $fh=  _is_fh($_[0])  ? shift : $t->{twig_output_fh} || select() || \*STDOUT;
  2735.     no strict 'refs';
  2736.     print {$fh} $t->prolog( @_);
  2737.   }
  2738.  
  2739. sub prolog
  2740.   { my $t= shift;
  2741.     if( $t->{no_prolog}){ return ''; }
  2742.  
  2743.     return   $t->{no_prolog}             ? '' 
  2744.            : defined $t->{no_dtd_output} ? $t->xmldecl
  2745.            :                               $t->xmldecl . $t->doctype( @_);
  2746.   }
  2747.  
  2748. sub doctype
  2749.   { my $t= shift;
  2750.     my %args= _normalize_args( @_);
  2751.     my $update_dtd = $args{UpdateDTD} || '';
  2752.     my $doctype_text='';
  2753.     
  2754.     my $doctype= $t->{twig_doctype};
  2755.  
  2756.     if( $doctype)
  2757.       { $doctype_text .= qq{<!DOCTYPE $doctype->{name}} if( $doctype->{name});
  2758.         $doctype_text .= qq{ PUBLIC "$doctype->{pub}"}  if( $doctype->{pub});
  2759.         $doctype_text .= qq{ SYSTEM}                    if( $doctype->{sysid} && !$doctype->{pub});
  2760.         $doctype_text .= qq{ "$doctype->{sysid}"}       if( $doctype->{sysid});
  2761.       }
  2762.  
  2763.     if( $update_dtd)
  2764.       { if( $doctype)  
  2765.           { my $internal=$doctype->{internal};
  2766.             # awfull hack, but at least it works a little better that what was there before
  2767.             if( $internal)
  2768.               { # remove entity declarations (they will be re-generated from the updated entity list)
  2769.                 $internal=~ s{<! \s* ENTITY \s+ $REG_NAME \s+ ( ("[^"]*"|'[^']*') \s* | SYSTEM [^>]*) >\s*}{}xg;
  2770.                 $internal=~ s{^\n}{};
  2771.               }
  2772.             $internal .= $t->entity_list->text ||'' if( $t->entity_list);
  2773.             if( $internal) { $doctype_text .= "[\n$internal]>\n"; }
  2774.           }
  2775.         elsif( !$t->{'twig_dtd'} && keys %{$t->entity_list}) 
  2776.           { $doctype_text .= "<!DOCTYPE " . $t->root->gi . " [\n" . $t->entity_list->text . "\n]>";;}
  2777.         else
  2778.           { my $doctype_text= $t->{twig_dtd};
  2779.             $doctype_text .= $t->dtd_text;
  2780.           }            
  2781.       }
  2782.     elsif( $doctype)
  2783.       { if( my $internal= $doctype->{internal}) 
  2784.           { # add opening and closing brackets if not already there
  2785.             # plus some spaces and newlines for a nice formating
  2786.             # I test it here because I can't remember which version of
  2787.             # XML::Parser need it or not, nor guess which one will in the
  2788.             # future, so this about the best I can do
  2789.             $internal=~ s{^\s*(\[\s*)?}{ [\n};
  2790.             $internal=~ s{\s*(\]\s*(>\s*)?)?\s*$}{\n]>\n};
  2791.             $doctype_text .=  $internal; 
  2792.           }
  2793.       }
  2794.       
  2795.     if( $doctype_text)
  2796.       {
  2797.         # terrible hack, as I can't figure out in which case the darn prolog
  2798.         # should get an extra > (depends on XML::Parser and expat versions)
  2799.         $doctype_text=~ s/(>\s*)*$/>\n/; # if($doctype_text);
  2800.  
  2801.         my $output_filter= XML::Twig::Elt::output_filter();
  2802.         return $output_filter ? $output_filter->( $doctype_text) : $doctype_text;
  2803.       }
  2804.     else
  2805.       { return $doctype_text; }
  2806.   }
  2807.  
  2808. sub _leading_cpi
  2809.   { my $t= shift;
  2810.     my $leading_cpi= $t->{leading_cpi} || return '';
  2811.     return $leading_cpi->xml_string;
  2812.   }
  2813.  
  2814. sub _trailing_cpi
  2815.   { my $t= shift;
  2816.     my $trailing_cpi= $t->{trailing_cpi} || return '';
  2817.     return $trailing_cpi->xml_string;
  2818.   }
  2819.  
  2820. sub _trailing_cpi_text
  2821.   { my $t= shift;
  2822.     return $t->{trailing_cpi_text} || '';
  2823.   }
  2824.  
  2825. sub print_to_file
  2826.   { my( $t, $filename)= (shift, shift);
  2827.     open( TWIG_PRINT_TO_FILE, ">$filename") or _croak( "cannot create file $filename: $!");
  2828.     $t->print( \*TWIG_PRINT_TO_FILE, @_);
  2829.     close TWIG_PRINT_TO_FILE;
  2830.     return $t;
  2831.   }
  2832.  
  2833. sub print
  2834.   { my $t= shift;
  2835.     my $fh=  _is_fh( $_[0])  ? shift : undef;
  2836.     my %args= _normalize_args( @_);
  2837.  
  2838.     if( $fh) { print {$fh} $t->sprint( %args); } else { print $t->sprint( %args); }
  2839.  
  2840.     return $t;
  2841.   }
  2842.  
  2843.  
  2844. sub flush
  2845.   { my $t= shift;
  2846.  
  2847.     $t->_trigger_tdh if $t->{twig_tdh};
  2848.  
  2849.     return if( $t->{twig_completely_flushed});
  2850.   
  2851.     my $fh=  _is_fh( $_[0]) ? shift : undef;
  2852.     my $old_select= defined $fh ? select $fh : undef;
  2853.     my $up_to= ref $_[0] ? shift : undef;
  2854.     my %args= _normalize_args( @_);
  2855.  
  2856.     my $old_pretty;
  2857.     if( defined $args{PrettyPrint})
  2858.       { $old_pretty= $t->set_pretty_print( $args{PrettyPrint}); 
  2859.         delete $args{PrettyPrint};
  2860.       }
  2861.  
  2862.      my $old_empty_tag_style;
  2863.      if( $args{EmptyTags})
  2864.       { $old_empty_tag_style= $t->set_empty_tag_style( $args{EmptyTags}); 
  2865.         delete $args{EmptyTags};
  2866.       }
  2867.  
  2868.  
  2869.     # the "real" last element processed, as _twig_end has closed it
  2870.     my $last_elt;
  2871.     my $flush_trailing_data=0;
  2872.     if( $up_to)
  2873.       { $last_elt= $up_to; }
  2874.     elsif( $t->{twig_current})
  2875.       { $last_elt= $t->{twig_current}->_last_child; }
  2876.     else
  2877.       { $last_elt= $t->{twig_root};
  2878.         $flush_trailing_data=1;
  2879.         $t->{twig_completely_flushed}=1;
  2880.       }
  2881.  
  2882.     # flush the DTD unless it has ready flushed (ie root has been flushed)
  2883.     my $elt= $t->{twig_root};
  2884.     unless( $elt->_flushed)
  2885.       { # store flush info so we can auto-flush later
  2886.         if( $t->{twig_autoflush})
  2887.           { $t->{twig_autoflush_data}={};
  2888.             $t->{twig_autoflush_data}->{fh}   = $fh  if( $fh);
  2889.             $t->{twig_autoflush_data}->{args} = \@_  if( @_);
  2890.           }
  2891.         $t->print_prolog( %args); 
  2892.         print $t->_leading_cpi;
  2893.       }
  2894.  
  2895.     while( $elt)
  2896.       { my $next_elt; 
  2897.         if( $last_elt && $last_elt->in( $elt))
  2898.           { 
  2899.             unless( $elt->_flushed) 
  2900.               { # just output the front tag
  2901.                 print $elt->start_tag();
  2902.                 $elt->_set_flushed;
  2903.               }
  2904.             $next_elt= $elt->{first_child};
  2905.           }
  2906.         else
  2907.           { # an element before the last one or the last one,
  2908.             $next_elt= $elt->{next_sibling};  
  2909.             $elt->_flush();
  2910.             $elt->delete; 
  2911.             last if( $last_elt && ($elt == $last_elt));
  2912.           }
  2913.         $elt= $next_elt;
  2914.       }
  2915.  
  2916.     if( $flush_trailing_data)
  2917.       { print $t->_trailing_cpi        # trailing comments and pi's (elements, in 'process' mode)
  2918.             , $t->_trailing_cpi_text   # trailing comments and pi's (in 'keep' mode)
  2919.       }
  2920.  
  2921.     select $old_select if( defined $old_select);
  2922.     $t->set_pretty_print( $old_pretty) if( defined $old_pretty); 
  2923.     $t->set_empty_tag_style( $old_empty_tag_style) if( defined $old_empty_tag_style); 
  2924.  
  2925.     return $t;
  2926.   }
  2927.  
  2928.  
  2929. # flushes up to an element
  2930. # this method just reorders the arguments and calls flush
  2931. sub flush_up_to
  2932.   { my $t= shift;
  2933.     my $up_to= shift;
  2934.     if( _is_fh( $_[0]))
  2935.       { my $fh=  shift;
  2936.         $t->flush( $fh, $up_to, @_);
  2937.       }
  2938.     else
  2939.       { $t->flush( $up_to, @_); }
  2940.  
  2941.     return $t;
  2942.   }
  2943.  
  2944.     
  2945. # same as print except the entire document text is returned as a string
  2946. sub sprint
  2947.   { my $t= shift;
  2948.     my %args= _normalize_args( @_);
  2949.  
  2950.     my $old_pretty;
  2951.     if( defined $args{PrettyPrint})
  2952.       { $old_pretty= $t->set_pretty_print( $args{PrettyPrint}); 
  2953.         delete $args{PrettyPrint};
  2954.       }
  2955.  
  2956.      my $old_empty_tag_style;
  2957.      if( defined $args{EmptyTags})
  2958.       { $old_empty_tag_style= $t->set_empty_tag_style( $args{EmptyTags}); 
  2959.         delete $args{EmptyTags};
  2960.       }
  2961.       
  2962.     my $string=   $t->prolog( %args)       # xml declaration and doctype
  2963.                 . $t->_leading_cpi( %args) # leading comments and pi's in 'process' mode
  2964.                 . $t->{twig_root}->sprint  
  2965.                 . $t->_trailing_cpi        # trailing comments and pi's (elements, in 'process' mode)
  2966.                 . $t->_trailing_cpi_text   # trailing comments and pi's (in 'keep' mode)
  2967.                 ;
  2968.  
  2969.     $t->set_pretty_print( $old_pretty) if( defined $old_pretty); 
  2970.     $t->set_empty_tag_style( $old_empty_tag_style) if( defined $old_empty_tag_style); 
  2971.  
  2972.     return $string;
  2973.   }
  2974.     
  2975.  
  2976. # this method discards useless elements in a tree
  2977. # it does the same thing as a flush except it does not print it
  2978. # the second argument is an element, the last purged element
  2979. # (this argument is usually set through the purge_up_to method)
  2980. sub purge
  2981.   { my $t= shift;
  2982.     my $up_to= shift;
  2983.  
  2984.     $t->_trigger_tdh if $t->{twig_tdh};
  2985.  
  2986.     # the "real" last element processed, as _twig_end has closed it
  2987.     my $last_elt;
  2988.     if( $up_to)
  2989.       { $last_elt= $up_to; }
  2990.     elsif( $t->{twig_current})
  2991.       { $last_elt= $t->{twig_current}->_last_child; }
  2992.     else
  2993.       { $last_elt= $t->{twig_root}; }
  2994.     
  2995.     my $elt= $t->{twig_root};
  2996.  
  2997.     while( $elt)
  2998.       { my $next_elt; 
  2999.         if( $last_elt && $last_elt->in( $elt))
  3000.           { $elt->_set_flushed;
  3001.             $next_elt= $elt->{first_child};
  3002.           }
  3003.         else
  3004.           { # an element before the last one or the last one,
  3005.             $next_elt= $elt->{next_sibling};  
  3006.             $elt->delete; 
  3007.             last if( $last_elt && ($elt == $last_elt) );
  3008.           }
  3009.         $elt= $next_elt;
  3010.       }
  3011.  
  3012.     return $t;
  3013.   }
  3014.     
  3015. # flushes up to an element. This method just calls purge
  3016. sub purge_up_to
  3017.   { my $t= shift;
  3018.     $t->purge( @_);
  3019.   }
  3020.  
  3021. sub root
  3022.   { return $_[0]->{twig_root}; }
  3023.  
  3024. sub normalize
  3025.   { return $_[0]->root->normalize; }
  3026.  
  3027. # create accessor methods on attribute names
  3028. { my %accessor; # memorize accessor names so re-creating them won't trigger an error
  3029. sub create_accessors
  3030.   { 
  3031.     _croak( "cannot use the create_accessors method with perl 5.005") if( $] < 5.006);
  3032.  
  3033.     my $twig_or_class= shift;
  3034.     my $elt_class= ref $twig_or_class ? $twig_or_class->{twig_elt_class}
  3035.                                       : 'XML::Twig::Elt'
  3036.                                       ;
  3037.     no strict 'refs';
  3038.     foreach my $att (@_)
  3039.       { _croak( "attempt to redefine existing method $att using create_accessors")
  3040.           if( $elt_class->can( $att) && !$accessor{$att});
  3041.  
  3042.         if( !$accessor{$att})                                # > perl 5.5
  3043.           { *{"$elt_class\::$att"}=                          # > perl 5.5
  3044.                 sub :lvalue                                  # > perl 5.5
  3045.                   { my $elt= shift;                          # > perl 5.5
  3046.                     if( @_) { $elt->{att}->{$att}= $_[0]; }  # > perl 5.5
  3047.                     $elt->{att}->{$att};                     # > perl 5.5
  3048.                   };                                         # > perl 5.5
  3049.             $accessor{$att}=1;                               # > perl 5.5
  3050.           }                                                  # > perl 5.5
  3051.       }
  3052.     return $twig_or_class;
  3053.   }
  3054. }
  3055.  
  3056.  
  3057. #start-extract twig_document (used to generate XML::(DOM|GDOME)::Twig)
  3058. sub first_elt
  3059.   { my( $t, $cond)= @_;
  3060.     my $root= $t->root || return undef;
  3061.     return $root if( $root->passes( $cond));
  3062.     return $root->next_elt( $cond); 
  3063.   }
  3064.  
  3065. sub last_elt
  3066.   { my( $t, $cond)= @_;
  3067.     my $root= $t->root || return undef;
  3068.     return $root->last_descendant( $cond); 
  3069.   }
  3070.  
  3071. sub next_n_elt
  3072.   { my( $t, $offset, $cond)= @_;
  3073.     $offset -- if( $t->root->matches( $cond) );
  3074.     return $t->root->next_n_elt( $offset, $cond);
  3075.   }
  3076.  
  3077. sub get_xpath
  3078.   { my $twig= shift;
  3079.     if( isa( $_[0], 'ARRAY'))
  3080.       { my $elt_array= shift;
  3081.         return _unique_elts( map { $_->get_xpath( @_) } @$elt_array);
  3082.       }
  3083.     else
  3084.       { return $twig->root->get_xpath( @_); }
  3085.   }
  3086.  
  3087. # get a list of elts and return a sorted list of unique elts
  3088. sub _unique_elts
  3089.   { my @sorted= sort { $a ->cmp( $b) } @_;
  3090.     my @unique;
  3091.     while( my $current= shift @sorted)
  3092.       { push @unique, $current unless( @unique && ($unique[-1] == $current)); }
  3093.     return @unique;
  3094.   }
  3095.  
  3096. sub findvalue
  3097.   { my $twig= shift;
  3098.     if( isa( $_[0], 'ARRAY'))
  3099.       { my $elt_array= shift;
  3100.         return join( '', map { $_->findvalue( @_) } @$elt_array);
  3101.       }
  3102.     else
  3103.       { return $twig->root->findvalue( @_); }
  3104.   }
  3105.  
  3106. sub set_id_seed
  3107.   { my $t= shift;
  3108.     XML::Twig::Elt->set_id_seed( @_);
  3109.   }
  3110.  
  3111. # return an array ref to an index, or undef
  3112. sub index
  3113.   { my( $twig, $name, $index)= @_;
  3114.     return defined( $index) ? $twig->{_twig_index}->{$name}->[$index] : $twig->{_twig_index}->{$name};
  3115.   }
  3116.  
  3117. # return a list with just the root
  3118. # if a condition is given then return an empty list unless the root matches
  3119. sub children
  3120.   { my( $t, $cond)= @_;
  3121.     my $root= $t->root;
  3122.     unless( $cond && !($root->passes( $cond)) )
  3123.       { return ($root); }
  3124.     else
  3125.       { return (); }
  3126.   }
  3127.   
  3128. sub _children { return ($_[0]->root); }
  3129.  
  3130. # weird, but here for completude
  3131. # used to solve (non-sensical) /doc[1] XPath queries
  3132. sub child
  3133.   { my $t= shift;
  3134.     my $nb= shift;
  3135.     return ($t->children( @_))[$nb];
  3136.   }
  3137.  
  3138. sub descendants
  3139.   { my( $t, $cond)= @_;
  3140.     my $root= $t->root;
  3141.     if( $root->passes( $cond) )
  3142.       { return ($root, $root->descendants( $cond)); }
  3143.     else
  3144.       { return ( $root->descendants( $cond)); }
  3145.   }
  3146.  
  3147. sub simplify  { my $t= shift; $t->root->simplify( @_);  }
  3148. sub subs_text { my $t= shift; $t->root->subs_text( @_); }
  3149. sub trim      { my $t= shift; $t->root->trim( @_);      }
  3150.  
  3151. #end-extract twig_document
  3152.  
  3153. sub set_keep_encoding
  3154.   { my( $t, $keep)= @_;
  3155.     $t->{twig_keep_encoding}= $keep;
  3156.     $t->{NoExpand}= $keep;
  3157.     return XML::Twig::Elt::set_keep_encoding( $keep);
  3158.  }
  3159.  
  3160. sub set_expand_external_entities
  3161.   { return XML::Twig::Elt::set_expand_external_entities( @_); }
  3162.  
  3163. # WARNING: at the moment the id list is not updated reliably
  3164. sub elt_id
  3165.   { return $_[0]->{twig_id_list}->{$_[1]}; }
  3166.  
  3167. # change it in ALL twigs at the moment
  3168. sub change_gi 
  3169.   { my( $twig, $old_gi, $new_gi)= @_;
  3170.     my $index;
  3171.     return unless($index= $XML::Twig::gi2index{$old_gi});
  3172.     $XML::Twig::index2gi[$index]= $new_gi;
  3173.     delete $XML::Twig::gi2index{$old_gi};
  3174.     $XML::Twig::gi2index{$new_gi}= $index;
  3175.   }
  3176.  
  3177.  
  3178. # builds the DTD from the stored (possibly updated) data
  3179. sub dtd_text
  3180.   { my $t= shift;
  3181.     my $dtd= $t->{twig_dtd};
  3182.     my $doctype= $t->{twig_doctype} or return '';
  3183.     my $string= "<!DOCTYPE ".$doctype->{name};
  3184.  
  3185.     $string .= " [\n";
  3186.  
  3187.     foreach my $gi (@{$dtd->{elt_list}})
  3188.       { $string.= "<!ELEMENT $gi ".$dtd->{model}->{$gi}.">\n" ;
  3189.         if( $dtd->{att}->{$gi})
  3190.           { my $attlist= $dtd->{att}->{$gi};
  3191.             $string.= "<!ATTLIST $gi\n";
  3192.             foreach my $att ( sort keys %{$attlist})
  3193.               { 
  3194.                 if( $attlist->{$att}->{fixed})
  3195.                   { $string.= "   $att $attlist->{$att}->{type} #FIXED $attlist->{$att}->{default}"; }
  3196.                 else
  3197.                   { $string.= "   $att $attlist->{$att}->{type} $attlist->{$att}->{default}"; }
  3198.                 $string.= "\n";
  3199.               }
  3200.             $string.= ">\n";
  3201.           }
  3202.       }
  3203.     $string.= $t->entity_list->text if( $t->entity_list);
  3204.     $string.= "\n]>\n";
  3205.     return $string;
  3206.   }
  3207.         
  3208. # prints the DTD from the stored (possibly updated) data
  3209. sub dtd_print
  3210.   { my $t= shift;
  3211.     my $fh=  _is_fh( $_[0])  ? shift : undef;
  3212.     if( $fh) { print $fh $t->dtd_text; }
  3213.     else     { print $t->dtd_text;     }
  3214.   }
  3215.  
  3216. # build the subs that call directly expat
  3217. BEGIN
  3218.   { my @expat_methods= qw( depth in_element within_element context
  3219.                            current_line current_column current_byte
  3220.                            recognized_string original_string 
  3221.                            xpcroak xpcarp 
  3222.                            xml_escape
  3223.                            base current_element element_index 
  3224.                            position_in_context);
  3225.     foreach my $method (@expat_methods)
  3226.       { no strict 'refs';
  3227.         *{$method}= sub { my $t= shift;
  3228.                           _croak( "calling $method after parsing is finished") unless( $t->{twig_parsing}); 
  3229.                           return $t->{twig_parser}->$method(@_); 
  3230.                         };
  3231.       }
  3232.   }
  3233.  
  3234. sub path
  3235.   { my( $t, $gi)= @_;
  3236.     if( $t->{twig_map_xmlns})
  3237.       { return "/" . join( "/", map { $t->_replace_prefix( $_)} ($t->{twig_parser}->context, $gi)); }
  3238.     else
  3239.       { return "/" . join( "/", ($t->{twig_parser}->context, $gi)); }
  3240.   }
  3241.  
  3242. sub finish
  3243.   { my $t= shift;
  3244.     return $t->{twig_parser}->finish;
  3245.   }
  3246.  
  3247. # just finish the parse by printing the rest of the document
  3248. sub finish_print
  3249.   { my( $t, $fh)= @_;
  3250.     my $old_fh;
  3251.     unless( defined $fh)
  3252.       { $t->_set_fh_to_twig_output_fh(); }
  3253.     elsif( defined $fh)
  3254.       { $old_fh= select $fh; 
  3255.         $t->{twig_original_selected_fh}= $old_fh if( $old_fh); 
  3256.       }
  3257.     
  3258.     my $p=$t->{twig_parser};
  3259.     if( $t->{twig_keep_encoding})
  3260.       { $p->setHandlers( %twig_handlers_finish_print); }
  3261.     else
  3262.       { $p->setHandlers( %twig_handlers_finish_print_original); }
  3263.   }
  3264.  
  3265. sub set_remove_cdata { return XML::Twig::Elt::set_remove_cdata( @_); }
  3266.  
  3267. sub output_filter     { return XML::Twig::Elt::output_filter( @_);     }
  3268. sub set_output_filter { return XML::Twig::Elt::set_output_filter( @_); }
  3269.  
  3270. sub output_text_filter { return XML::Twig::Elt::output_text_filter( @_); }
  3271. sub set_output_text_filter { return XML::Twig::Elt::set_output_text_filter( @_); }
  3272.  
  3273. sub set_input_filter
  3274.   { my( $t, $input_filter)= @_;
  3275.     my $old_filter= $t->{twig_input_filter};
  3276.       if( !$input_filter || isa( $input_filter, 'CODE') )
  3277.         { $t->{twig_input_filter}= $input_filter; }
  3278.       elsif( $input_filter eq 'latin1')
  3279.         {  $t->{twig_input_filter}= latin1(); }
  3280.       elsif( $filter{$input_filter})
  3281.         {  $t->{twig_input_filter}= $filter{$input_filter}; }
  3282.       else
  3283.         { _croak( "invalid input filter: $input_filter"); }
  3284.       
  3285.       return $old_filter;
  3286.     }
  3287.  
  3288. sub set_empty_tag_style
  3289.   { return XML::Twig::Elt::set_empty_tag_style( @_); }
  3290.  
  3291. sub set_pretty_print
  3292.   { return XML::Twig::Elt::set_pretty_print( @_); }
  3293.  
  3294. sub set_quote
  3295.   { return XML::Twig::Elt::set_quote( @_); }
  3296.  
  3297. sub set_indent
  3298.   { return XML::Twig::Elt::set_indent( @_); }
  3299.  
  3300. sub set_keep_atts_order
  3301.   { shift; return XML::Twig::Elt::set_keep_atts_order( @_); }
  3302.  
  3303. sub keep_atts_order
  3304.   { return XML::Twig::Elt::keep_atts_order( @_); }
  3305.  
  3306. sub set_do_not_escape_amp_in_atts
  3307.   { return XML::Twig::Elt::set_do_not_escape_amp_in_atts( @_); }
  3308.  
  3309. # save and restore package globals (the ones in XML::Twig::Elt)
  3310. sub save_global_state
  3311.   { my $t= shift;
  3312.     $t->{twig_saved_state}= XML::Twig::Elt::global_state();
  3313.   }
  3314.  
  3315. sub restore_global_state
  3316.   { my $t= shift;
  3317.     XML::Twig::Elt::set_global_state( $t->{twig_saved_state});
  3318.   }
  3319.  
  3320. sub global_state
  3321.   { return XML::Twig::Elt::global_state(); }
  3322.  
  3323. sub set_global_state
  3324.   {  return XML::Twig::Elt::set_global_state( $_[1]); }
  3325.  
  3326. sub dispose
  3327.   { my $t= shift;
  3328.     $t->DESTROY;
  3329.   }
  3330.   
  3331. sub DESTROY
  3332.   { my $t= shift;
  3333.     if( $t->{twig_root} && isa(  $t->{twig_root}, 'XML::Twig')) 
  3334.       { $t->{twig_root}->delete } 
  3335.  
  3336.     # added to break circular references
  3337.     undef $t->{twig};
  3338.     undef $t->{twig_root}->{twig} if( $t->{twig_root});
  3339.     undef $t->{twig_parser};
  3340.     
  3341.     $t={}; # prevents memory leaks (especially when using mod_perl)
  3342.     undef $t;
  3343.   }        
  3344.  
  3345.  
  3346. #
  3347. #  non standard handlers
  3348. #
  3349.  
  3350. # kludge: expat 1.95.2 calls both Default AND Doctype handlers
  3351. # so if the default handler finds '<!DOCTYPE' then it must 
  3352. # unset itself (_twig_print_doctype will reset it)
  3353. sub _twig_print_check_doctype
  3354.    { # warn " in _twig_print_check_doctype...\n"; # DEBUG handler
  3355.     
  3356.     my $p= shift;
  3357.     my $string= $p->recognized_string();
  3358.     if( $string eq '<!DOCTYPE') 
  3359.       { 
  3360.         $p->setHandlers( Default => undef); 
  3361.         $p->setHandlers( Entity => undef); 
  3362.         $p->{twig}->{expat_1_95_2}=1; 
  3363.       }
  3364.     else                        
  3365.       { 
  3366.         print $string;
  3367.       }
  3368.     
  3369.   }
  3370.  
  3371.  
  3372. sub _twig_print
  3373.    { # warn " in _twig_print...\n"; # DEBUG handler
  3374.     my $p= shift;
  3375.     if( $p->{twig}->{expat_1_95_2} && ($p->recognized_string eq '[') && !$p->{twig}->{expat_1_95_2_seen_bracket})
  3376.       { # otherwise the opening square bracket of the doctype gets printed twice 
  3377.         $p->{twig}->{expat_1_95_2_seen_bracket}=1;
  3378.       }
  3379.     else
  3380.       { 
  3381.         print $p->recognized_string();
  3382.       }
  3383.   }
  3384. # recognized_string does not seem to work for entities, go figure!
  3385. # so this handler is used to print them anyway
  3386. sub _twig_print_entity
  3387.    { # warn " in _twig_print_entity...\n"; # DEBUG handler
  3388.     my $p= shift; 
  3389.     XML::Twig::Entity->new( @_)->print;
  3390.   }
  3391.  
  3392. # kludge: expat 1.95.2 calls both Default AND Doctype handlers
  3393. # so if the default handler finds '<!DOCTYPE' then it must 
  3394. # unset itself (_twig_print_doctype will reset it)
  3395. sub _twig_print_original_check_doctype
  3396.    { # warn " in _twig_print_original_check_doctype...\n"; # DEBUG handler
  3397.     
  3398.     my $p= shift;
  3399.     my $string= $p->original_string();
  3400.     if( $string eq '<!DOCTYPE') 
  3401.       { $p->setHandlers( Default => undef); 
  3402.         $p->setHandlers( Entity => undef); 
  3403.         $p->{twig}->{expat_1_95_2}=1; 
  3404.       }
  3405.     else                        
  3406.       { print $string; }
  3407.     
  3408.   }
  3409.  
  3410. sub _twig_print_original
  3411.    { # warn " in _twig_print_original...\n"; # DEBUG handler
  3412.     my $p= shift; 
  3413.     print $p->original_string();
  3414.   }
  3415.  
  3416.  
  3417. sub _twig_print_original_doctype
  3418.    { # warn " in _twig_print_original_doctype...\n"; # DEBUG handler
  3419.     
  3420.     my(  $p, $name, $sysid, $pubid, $internal)= @_;
  3421.     if( $name)
  3422.       { # with recent versions of XML::Parser original_string does not work,
  3423.         # hence we need to rebuild the doctype declaration
  3424.         my $doctype='';
  3425.         $doctype .= qq{<!DOCTYPE $name}    if( $name);
  3426.         $doctype .=  qq{ PUBLIC  "$pubid"}  if( $pubid);
  3427.         $doctype .=  qq{ SYSTEM}            if( $sysid && !$pubid);
  3428.         $doctype .=  qq{ "$sysid"}          if( $sysid); 
  3429.         $doctype .=  ' [' if( $internal && !$p->{twig}->{expat_1_95_2}) ;
  3430.         $doctype .=  qq{>} unless( $internal || $p->{twig}->{expat_1_95_2});
  3431.         $p->{twig}->{twig_doctype}->{has_internal}=$internal;
  3432.         print $doctype;
  3433.       }
  3434.     $p->setHandlers( Default => \&_twig_print_original);
  3435.   }
  3436.  
  3437. sub _twig_print_doctype
  3438.    { # warn " in _twig_print_doctype...\n"; # DEBUG handler
  3439.     my(  $p, $name, $sysid, $pubid, $internal)= @_;
  3440.     if( $name)
  3441.       { # with recent versions of XML::Parser original_string does not work,
  3442.         # hence we need to rebuild the doctype declaration
  3443.         my $doctype='';
  3444.         $doctype .= qq{<!DOCTYPE $name}    if( $name);
  3445.         $doctype .=  qq{ PUBLIC  "$pubid"}  if( $pubid);
  3446.         $doctype .=  qq{ SYSTEM}            if( $sysid && !$pubid);
  3447.         $doctype .=  qq{ "$sysid"}          if( $sysid); 
  3448.         $doctype .=  ' [' if( $internal) ;
  3449.         $doctype .=  qq{>} unless( $internal || $p->{twig}->{expat_1_95_2});
  3450.         $p->{twig}->{twig_doctype}->{has_internal}=$internal;
  3451.         print $doctype;
  3452.       }
  3453.     $p->setHandlers( Default => \&_twig_print);
  3454.   }
  3455.  
  3456.  
  3457. sub _twig_print_original_default
  3458.    { # warn " in _twig_print_original_default...\n"; # DEBUG handler
  3459.     my $p= shift;
  3460.     print $p->original_string();
  3461.   }
  3462.  
  3463. # account for the case where the element is empty
  3464. sub _twig_print_end_original
  3465.    { # warn " in _twig_print_end_original...\n"; # DEBUG handler
  3466.     my $p= shift;
  3467.     print $p->original_string();
  3468.   }
  3469.  
  3470. sub _twig_start_check_roots
  3471.    { # warn " in _twig_start_check_roots...\n"; # DEBUG handler
  3472.     my( $p, $gi, %att)= @_;
  3473.     my $t= $p->{twig};
  3474.     
  3475.     # $tag will always be true if it needs to be printed (the tag string is never empty)
  3476.     my $tag= $t->{twig_default_print} ? $t->{twig_keep_encoding} ? $p->original_string
  3477.                                                                  : $p->recognized_string
  3478.                                       : '';
  3479.     my $fh= $t->{twig_output_fh} || select() || \*STDOUT;
  3480.  
  3481.     unless( $p->depth == 0)
  3482.       { if( $t->{twig_map_xmlns}) { my @att= splice( @_, 2); _replace_ns( $t, \$gi, \@att); %att= @att; }
  3483.       }
  3484.  
  3485.     push @{$t->{_twig_context_stack}}, { _tag => $gi, %att};
  3486.  
  3487.     if( _handler( $t, $t->{twig_roots}, $gi, \%att))
  3488.       { $p->setHandlers( %twig_handlers); # restore regular handlers
  3489.         $t->{twig_root_depth}= $p->depth; 
  3490.         pop @{$t->{_twig_context_stack}}; # will be pushed back in _twig_start
  3491.         _twig_start( $p, $gi, %att);
  3492.       }
  3493.     elsif( $p->depth == 0)
  3494.       { no strict 'refs';
  3495.         print {$fh} $tag if( $tag);
  3496.         pop @{$t->{_twig_context_stack}}; # will be pushed back in _twig_start
  3497.         _twig_start( $p, $gi, %att);
  3498.         $t->root->_set_flushed; # or the root start tag gets output the first time we flush
  3499.       }
  3500.     elsif( $t->{twig_starttag_handlers})
  3501.       { # look for start tag handlers
  3502.  
  3503.         my @handlers= _handler( $t, $t->{twig_starttag_handlers}, $gi, \%att);
  3504.         my $last_handler_res;
  3505.         foreach my $handler ( @handlers)
  3506.           { $last_handler_res= $handler->($t, $gi, %att);
  3507.             last unless $last_handler_res;
  3508.           }
  3509.         no strict 'refs';
  3510.         print {$fh} $tag if( $tag && (!@handlers || $last_handler_res));   
  3511.       }
  3512.     else
  3513.       { no strict 'refs';
  3514.         print {$fh} $tag if( $tag); 
  3515.       }  
  3516.   }
  3517.  
  3518. sub _twig_end_check_roots
  3519.    { # warn " in _twig_end_check_roots...\n"; # DEBUG handler
  3520.     
  3521.     my( $p, $gi, %att)= @_;
  3522.     my $t= $p->{twig};
  3523.     # $tag can be empty (<elt/>), hence the undef and the tests for defined
  3524.     my $tag= $t->{twig_default_print} ? $t->{twig_keep_encoding} ? $p->original_string
  3525.                                                                  : $p->recognized_string
  3526.                                       : undef;
  3527.     my $fh= $t->{twig_output_fh} || select() || \*STDOUT;
  3528.     
  3529.     if( $t->{twig_endtag_handlers})
  3530.       { # look for end tag handlers
  3531.         my @handlers= _handler( $t, $t->{twig_endtag_handlers}, $gi, {});
  3532.         my $last_handler_res=1;
  3533.         foreach my $handler ( @handlers)
  3534.           { $last_handler_res= $handler->($t, $gi) || last; }
  3535.         if( ! $last_handler_res) 
  3536.           { pop @{$t->{_twig_context_stack}};
  3537.             return;
  3538.           }
  3539.       }
  3540.     {
  3541.       no strict 'refs';
  3542.       print {$fh} $tag if( defined( $tag));
  3543.     }
  3544.     if( $p->depth == 0)
  3545.       { _twig_end( $p, $gi);  }
  3546.     pop @{$t->{_twig_context_stack}};
  3547.   }
  3548.  
  3549. sub _twig_pi_check_roots
  3550.    { # warn " in _twig_pi_check_roots...\n"; # DEBUG handler
  3551.     my( $p, $target, $data)= @_;
  3552.     my $t= $p->{twig};
  3553.     my $pi= $t->{twig_default_print} ? $t->{twig_keep_encoding} ? $p->original_string
  3554.                                                                 : $p->recognized_string
  3555.                                     : undef;
  3556.     my $fh= $t->{twig_output_fh} || select() || \*STDOUT;
  3557.     
  3558.     if( my $handler=    $t->{twig_handlers}->{pi_handlers}->{$target}
  3559.                      || $t->{twig_handlers}->{pi_handlers}->{''}
  3560.       )
  3561.       { # if handler is called on pi, then it needs to be processed as a regular node
  3562.         my @flags= qw( twig_process_pi twig_keep_pi);
  3563.         my @save= @{$t}{@flags}; # save pi related flags
  3564.         @{$t}{@flags}= (1, 0);   # override them, pi needs to be processed
  3565.         _twig_pi( @_);           # call handler on the pi
  3566.         @{$t}{@flags}= @save;;   # restore flag
  3567.       }
  3568.     else
  3569.       { no strict 'refs';
  3570.         print  {$fh} $pi if( defined( $pi));
  3571.       }
  3572.   }
  3573.  
  3574.  
  3575. sub _twig_ignore_start
  3576.    { # warn " in _twig_ignore_start...\n"; # DEBUG handler
  3577.     
  3578.     my( $p, $gi)= @_;
  3579.     my $t= $p->{twig};
  3580.     $t->{twig_ignore_level}++;
  3581.     my $action= $t->{twig_ignore_action};
  3582.     if( $action eq 'print' ) { _twig_print_original( @_); }
  3583. #    elsif( $action eq 'string' )
  3584. #      { $t->{twig_buffered_string} .= $p->original_string(); }
  3585.   }
  3586.  
  3587. sub _twig_ignore_end
  3588.    { # warn " in _twig_ignore_end...\n"; # DEBUG handler
  3589.     
  3590.     my( $p, $gi)= @_;
  3591.     my $t= $p->{twig};
  3592.  
  3593.     my $action= $t->{twig_ignore_action};
  3594.  
  3595.     if( $action eq 'print')
  3596.       { _twig_print_original( $p, $gi); }
  3597. #    elsif( $action eq 'string')
  3598. #      { $t->{twig_buffered_string} .= $p->original_string(); }
  3599.  
  3600.     $t->{twig_ignore_level}--;
  3601.  
  3602.     if( ! $t->{twig_ignore_level})
  3603.       { 
  3604.         $t->{twig_current}   = $t->{twig_ignore_elt};
  3605.         $t->{twig_current}->set_twig_current;
  3606.  
  3607.         $t->{twig_ignore_elt}->cut;  # there could possibly be a memory leak here (delete would avoid it,
  3608.                                      # but could also delete elements that should not be deleted)
  3609.  
  3610.         # restore the saved stack to the current level
  3611.         splice( @{$t->{_twig_context_stack}}, $p->depth+ 1 );
  3612.         #warn "stack: ", _dump_stack( $t->{_twig_context_stack}), "\n";
  3613.  
  3614.         $p->setHandlers( @{$t->{twig_saved_handlers}});
  3615.         # test for handlers
  3616.         if( $t->{twig_endtag_handlers})
  3617.           { # look for end tag handlers
  3618.             my @handlers= _handler( $t, $t->{twig_endtag_handlers}, $gi, {});
  3619.             my $last_handler_res=1;
  3620.             foreach my $handler ( @handlers)
  3621.               { $last_handler_res= $handler->($t, $gi) || last; }
  3622.           }
  3623.         pop @{$t->{_twig_context_stack}};
  3624.       };
  3625.   }
  3626.  
  3627. #sub _dump_stack { my( $stack)= @_; return join( ":", map { $_->{_tag} } @$stack); }
  3628.     
  3629. sub ignore
  3630.   { my( $t, $elt)= @_;
  3631.     my $current= $t->{twig_current};
  3632.  
  3633.     if( ! ($elt && isa( $elt, 'XML::Twig::Elt'))) { $elt= $current; }
  3634.  
  3635.     #warn "ignore:  current = ", $current->tag, ", elt = ", $elt->tag, ")\n";
  3636.  
  3637.     # we need the ($elt == $current->{last_child}) test because the current element is set to the
  3638.     # parent _before_ handlers are called (and I can't figure out how to fix this)
  3639.     unless( ($elt == $current) || ($current->{last_child} && ($elt == $current->{last_child})) || $current->in( $elt)) 
  3640.       { _croak( "element to be ignored must be ancestor of current element"); }
  3641.  
  3642.     $t->{twig_ignore_level}= $current == $elt ? 1 : $t->_level_in_stack( $current) - $t->_level_in_stack($elt) + 1;
  3643.     #warn "twig_ignore_level:  $t->{twig_ignore_level} (current: ", $current->tag, ", elt: ", $elt->tag, ")\n";
  3644.     $t->{twig_ignore_elt}  = $elt;     # save it, so we can delete it later
  3645.  
  3646.     my $action= shift || 1; 
  3647.     $t->{twig_ignore_action}= $action;
  3648.  
  3649.     my $p= $t->{twig_parser};
  3650.     my @saved_handlers= $p->setHandlers( %twig_handlers_ignore); # set handlers
  3651.     if( $action eq 'print')
  3652.       { $p->setHandlers( Default => \&_twig_print_original); }
  3653. #    elsif( $action eq 'string')
  3654. #      { # not used at the moment
  3655. #        $t->{twig_buffered_string}='';
  3656. #        $p->setHandlers( Default => \&twig_buffer_original);
  3657. #      }
  3658.  
  3659.     $t->{twig_saved_handlers}= \@saved_handlers;        # save current handlers
  3660.   }
  3661.  
  3662. sub _level_in_stack
  3663.   { my( $t, $elt)= @_;
  3664.     my $level=1;
  3665.     foreach my $elt_in_stack ( @{$t->{_twig_context_stack}} )
  3666.       { if( $elt_in_stack->{_elt} && ($elt == $elt_in_stack->{_elt})) { return $level }
  3667.         $level++;
  3668.       }
  3669.   }
  3670.  
  3671.  
  3672.  
  3673. # select $t->{twig_output_fh} and store the current selected fh 
  3674. sub _set_fh_to_twig_output_fh
  3675.   { my $t= shift;
  3676.     my $output_fh= $t->{twig_output_fh};
  3677.     if( $output_fh && !$t->{twig_output_fh_selected})
  3678.       { # there is an output fh
  3679.         $t->{twig_selected_fh}= select(); # store the currently selected fh
  3680.         $t->{twig_output_fh_selected}=1;
  3681.         select $output_fh;                # select the output fh for the twig
  3682.       }
  3683.   }
  3684.  
  3685. # select the fh that was stored in $t->{twig_selected_fh} 
  3686. # (before $t->{twig_output_fh} was selected)
  3687. sub _set_fh_to_selected_fh
  3688.   { my $t= shift;
  3689.     return unless( $t->{twig_output_fh});
  3690.     my $selected_fh= $t->{twig_selected_fh};
  3691.     $t->{twig_output_fh_selected}=0;
  3692.     select $selected_fh;
  3693.     return;
  3694.   }
  3695.   
  3696.  
  3697. sub encoding
  3698.   { return $_[0]->{twig_xmldecl}->{encoding} if( $_[0]->{twig_xmldecl}); }
  3699.  
  3700. sub set_encoding
  3701.   { my( $t, $encoding)= @_;
  3702.     $t->{twig_xmldecl} ||={};
  3703.     $t->set_xml_version( "1.0") unless( $t->xml_version);
  3704.     $t->{twig_xmldecl}->{encoding}= $encoding;
  3705.     return $t;
  3706.   }
  3707.  
  3708. sub output_encoding
  3709.   { return $_[0]->{output_encoding}; }
  3710.   
  3711. sub set_output_encoding
  3712.   { my( $t, $encoding)= @_;
  3713.     $t->set_output_filter( _encoding_filter( $encoding)) if( $encoding);
  3714.     return $t->{output_encoding}= $encoding;
  3715.   }
  3716.  
  3717. sub xml_version
  3718.   { return $_[0]->{twig_xmldecl}->{version} if( $_[0]->{twig_xmldecl}); }
  3719.  
  3720. sub set_xml_version
  3721.   { my( $t, $version)= @_;
  3722.     $t->{twig_xmldecl} ||={};
  3723.     return $t->{twig_xmldecl}->{version}= $version;
  3724.   }
  3725.  
  3726. sub standalone
  3727.   { return $_[0]->{twig_xmldecl}->{standalone} if( $_[0]->{twig_xmldecl}); }
  3728.  
  3729. sub set_standalone
  3730.   { my( $t, $standalone)= @_;
  3731.     $t->{twig_xmldecl} ||={};
  3732.     $t->set_xml_version( "1.0") unless( $t->xml_version);
  3733.     return $t->{twig_xmldecl}->{standalone}= $standalone;
  3734.   }
  3735.  
  3736.  
  3737. # SAX methods
  3738.  
  3739. sub toSAX1
  3740.   { _croak( "cannot use toSAX1 while parsing (use flush_toSAX1)") if (defined $_[0]->{twig_parser});
  3741.     shift(@_)->_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX1,
  3742.                           \&XML::Twig::Elt::_end_tag_data_SAX1
  3743.              ); }
  3744.  
  3745. sub toSAX2
  3746.   { _croak( "cannot use toSAX2 while parsing (use flush_toSAX2)") if (defined $_[0]->{twig_parser});
  3747.     shift(@_)->_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX2,
  3748.                           \&XML::Twig::Elt::_end_tag_data_SAX2
  3749.              ); }
  3750.  
  3751.  
  3752. sub _toSAX
  3753.   { my( $t, $handler, $start_tag_data, $end_tag_data) = @_;
  3754.  
  3755.     if( my $start_document =  $handler->can( 'start_document'))
  3756.       { $start_document->( $handler); }
  3757.     
  3758.     $t->_prolog_toSAX( $handler);
  3759.     
  3760.     $t->root->_toSAX( $handler, $start_tag_data, $end_tag_data)  if( $t->root);
  3761.     if( my $end_document =  $handler->can( 'end_document'))
  3762.       { $end_document->( $handler); }
  3763.   }
  3764.  
  3765.  
  3766. sub flush_toSAX1
  3767.   { shift(@_)->_flush_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX1,
  3768.                                \&XML::Twig::Elt::_end_tag_data_SAX1
  3769.              ); 
  3770.   }
  3771.  
  3772. sub flush_toSAX2
  3773.   { shift(@_)->_flush_toSAX(@_, \&XML::Twig::Elt::_start_tag_data_SAX2,
  3774.                                \&XML::Twig::Elt::_end_tag_data_SAX2
  3775.              ); 
  3776.   }
  3777.  
  3778. sub _flush_toSAX
  3779.   { my( $t, $handler, $start_tag_data, $end_tag_data)= @_;
  3780.  
  3781.     # the "real" last element processed, as _twig_end has closed it
  3782.     my $last_elt;
  3783.     if( $t->{twig_current})
  3784.       { $last_elt= $t->{twig_current}->_last_child; }
  3785.     else
  3786.       { $last_elt= $t->{twig_root}; }
  3787.  
  3788.     my $elt= $t->{twig_root};
  3789.     unless( $elt->_flushed)
  3790.       { # init unless already done (ie root has been flushed)
  3791.         if( my $start_document =  $handler->can( 'start_document'))
  3792.           { $start_document->( $handler); }
  3793.         # flush the DTD
  3794.         $t->_prolog_toSAX( $handler) 
  3795.       }
  3796.  
  3797.     while( $elt)
  3798.       { my $next_elt; 
  3799.         if( $last_elt && $last_elt->in( $elt))
  3800.           { 
  3801.             unless( $elt->_flushed) 
  3802.               { # just output the front tag
  3803.                 if( my $start_element = $handler->can( 'start_element'))
  3804.                  { if( my $tag_data= $start_tag_data->( $elt))
  3805.                      { $start_element->( $handler, $tag_data); }
  3806.                  }
  3807.                 $elt->_set_flushed;
  3808.               }
  3809.             $next_elt= $elt->{first_child};
  3810.           }
  3811.         else
  3812.           { # an element before the last one or the last one,
  3813.             $next_elt= $elt->{next_sibling};  
  3814.             $elt->_toSAX( $handler, $start_tag_data, $end_tag_data);
  3815.             $elt->delete; 
  3816.             last if( $last_elt && ($elt == $last_elt));
  3817.           }
  3818.         $elt= $next_elt;
  3819.       }
  3820.     if( !$t->{twig_parsing}) 
  3821.       { if( my $end_document =  $handler->can( 'end_document'))
  3822.           { $end_document->( $handler); }
  3823.       }
  3824.   }
  3825.  
  3826.  
  3827. sub _prolog_toSAX
  3828.   { my( $t, $handler)= @_;
  3829.     $t->_xmldecl_toSAX( $handler);
  3830.     $t->_DTD_toSAX( $handler);
  3831.   }
  3832.  
  3833. sub _xmldecl_toSAX
  3834.   { my( $t, $handler)= @_;
  3835.     my $decl= $t->{twig_xmldecl};
  3836.     my $data= { Version    => $decl->{version},
  3837.                 Encoding   => $decl->{encoding},
  3838.                 Standalone => $decl->{standalone},
  3839.           };
  3840.     if( my $xml_decl= $handler->can( 'xml_decl'))
  3841.       { $xml_decl->( $handler, $data); }
  3842.   }
  3843.                 
  3844. sub _DTD_toSAX
  3845.   { my( $t, $handler)= @_;
  3846.     my $doctype= $t->{twig_doctype};
  3847.     return unless( $doctype);
  3848.     my $data= { Name     => $doctype->{name},
  3849.                 PublicId => $doctype->{pub},
  3850.                 SystemId => $doctype->{sysid},
  3851.               };
  3852.  
  3853.     if( my $start_dtd= $handler->can( 'start_dtd'))
  3854.       { $start_dtd->( $handler, $data); }
  3855.  
  3856.     # I should call code to export the internal subset here 
  3857.     
  3858.     if( my $end_dtd= $handler->can( 'end_dtd'))
  3859.       { $end_dtd->( $handler); }
  3860.   }
  3861.  
  3862. # input/output filters
  3863.  
  3864. sub latin1 
  3865.   { local $SIG{__DIE__};
  3866.     if( _use(  'Encode'))
  3867.       { return encode_convert( 'ISO-8859-15'); }
  3868.     elsif( _use( 'Text::Iconv'))
  3869.       { return iconv_convert( 'ISO-8859-15'); }
  3870.     elsif( _use( 'Unicode::Map8') && _use( 'Unicode::String'))
  3871.       { return unicode_convert( 'ISO-8859-15'); }
  3872.     else
  3873.       { return \®exp2latin1; }
  3874.   }
  3875.  
  3876. sub _encoding_filter
  3877.   { 
  3878.       { local $SIG{__DIE__};
  3879.         my $encoding= $_[1] || $_[0];
  3880.         if( _use( 'Encode'))
  3881.           { my $sub= encode_convert( $encoding);
  3882.             return $sub;
  3883.           }
  3884.         elsif( _use( 'Text::Iconv'))
  3885.           { return iconv_convert( $encoding); }
  3886.         elsif( _use( 'Unicode::Map8') && _use( 'Unicode::String'))
  3887.           { return unicode_convert( $encoding); }
  3888.         }
  3889.     _croak( "Encode, Text::Iconv or Unicode::Map8 and Unicode::String need to be installed in order to use encoding options");
  3890.   }
  3891.  
  3892. # shamelessly lifted from XML::TyePYX (works only with XML::Parse 2.27)
  3893. sub regexp2latin1
  3894.   { my $text=shift;
  3895.     $text=~s{([\xc0-\xc3])(.)}{ my $hi = ord($1);
  3896.                                 my $lo = ord($2);
  3897.                                 chr((($hi & 0x03) <<6) | ($lo & 0x3F))
  3898.                               }ge;
  3899.     return $text;
  3900.   }
  3901.  
  3902.  
  3903. sub html_encode
  3904.   { _use( 'HTML::Entities') or croak "cannot use html_encode: missing HTML::Entities";
  3905.     return HTML::Entities::encode_entities($_[0] );
  3906.   }
  3907.  
  3908. sub safe_encode
  3909.   {   my $str= shift;
  3910.       if( $] < 5.008)
  3911.         { # the no utf8 makes the regexp work in 5.6
  3912.           $str =~ s{([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)}
  3913.                    {_XmlUtf8Decode($1)}egs; 
  3914.         }
  3915.       else
  3916.         { $str= encode( ascii => $str, $FB_HTMLCREF); }
  3917.       return $str;
  3918.   }
  3919.  
  3920. sub safe_encode_hex
  3921.   {   my $str= shift;
  3922.       if( $] < 5.008)
  3923.         { # the no utf8 makes the regexp work in 5.6
  3924.           $str =~ s{([\xC0-\xDF].|[\xE0-\xEF]..|[\xF0-\xFF]...)}
  3925.                    {_XmlUtf8Decode($1, 1)}egs; 
  3926.         }
  3927.       else
  3928.         { $str= encode( ascii => $str, $FB_XMLCREF); }
  3929.       return $str;
  3930.   }
  3931.  
  3932. # this one shamelessly lifted from XML::DOM
  3933. # does NOT work on 5.8.0
  3934. sub _XmlUtf8Decode
  3935.   { my ($str, $hex) = @_;
  3936.     my $len = length ($str);
  3937.     my $n;
  3938.  
  3939.     if ($len == 2)
  3940.       { my @n = unpack "C2", $str;
  3941.         $n = (($n[0] & 0x3f) << 6) + ($n[1] & 0x3f);
  3942.       }
  3943.     elsif ($len == 3)
  3944.       { my @n = unpack "C3", $str;
  3945.         $n = (($n[0] & 0x1f) << 12) + (($n[1] & 0x3f) << 6) + ($n[2] & 0x3f);
  3946.       }
  3947.     elsif ($len == 4)
  3948.       { my @n = unpack "C4", $str;
  3949.         $n = (($n[0] & 0x0f) << 18) + (($n[1] & 0x3f) << 12) 
  3950.            + (($n[2] & 0x3f) << 6) + ($n[3] & 0x3f);
  3951.       }
  3952.     elsif ($len == 1)    # just to be complete...
  3953.       { $n = ord ($str); }
  3954.     else
  3955.       { croak "bad value [$str] for _XmlUtf8Decode"; }
  3956.  
  3957.     my $char= $hex ? sprintf ("&#x%x;", $n) : "&#$n;";
  3958.     return $char;
  3959. }
  3960.  
  3961.  
  3962. sub unicode_convert
  3963.   { my $enc= $_[1] ? $_[1] : $_[0]; # so the method can be called on the twig or directly
  3964.     _use( 'Unicode::Map8') or croak "Unicode::Map8 not available, needed for encoding filter: $!";
  3965.     _use( 'Unicode::String') or croak "Unicode::String not available, needed for encoding filter: $!";
  3966.     import Unicode::String qw(utf8);
  3967.     my $sub= eval q{
  3968.             { my $cnv;
  3969.               BEGIN {  $cnv= Unicode::Map8->new($enc) 
  3970.                            or croak "Can't create converter to $enc";
  3971.                     }
  3972.               sub { return  $cnv->to8 (utf8($_[0])->ucs2); } 
  3973.             } 
  3974.                    };
  3975.     unless( $sub) { croak $@; }
  3976.     return $sub;
  3977.   }
  3978.  
  3979. sub iconv_convert
  3980.   { my $enc= $_[1] ? $_[1] : $_[0]; # so the method can be called on the twig or directly
  3981.     _use( 'Text::Iconv') or croak "Text::Iconv not available, needed for encoding filter: $!";
  3982.     my $sub= eval q{
  3983.             { my $cnv;
  3984.               BEGIN { $cnv = Text::Iconv->new( 'utf8', $enc) 
  3985.                            or croak "Can't create iconv converter to $enc";
  3986.                     }
  3987.               sub { return  $cnv->convert( $_[0]); } 
  3988.             }       
  3989.                    };
  3990.     unless( $sub)
  3991.       { if( $@=~ m{^Unsupported conversion: Invalid argument})
  3992.           { croak "Unsupported encoding: $enc"; }
  3993.         else
  3994.           { croak $@; }
  3995.       }
  3996.  
  3997.     return $sub;
  3998.   }
  3999.  
  4000. sub encode_convert
  4001.   { my $enc= $_[1] ? $_[1] : $_[0]; # so the method can be called on the twig or directly
  4002.     my $sub=  eval qq{sub { return encode( "$enc", \$_[0]); } };
  4003.     croak "can't create Encode-based filter: $@" unless( $sub);
  4004.     return $sub;
  4005.   }
  4006.  
  4007.  
  4008. # XML::XPath compatibility
  4009. sub getRootNode        { return $_[0]; }
  4010. sub getParentNode      { return undef; }
  4011. sub getChildNodes      { my @children= ($_[0]->root); return wantarray ? @children : \@children; }
  4012.  
  4013. sub _weakrefs
  4014.   { return $weakrefs; }
  4015.  
  4016. sub _dump
  4017.   { my $t= shift;
  4018.     my $dump='';
  4019.  
  4020.     $dump="document\n"; # should dump twig level data here
  4021.     $dump .= $t->root->_dump( @_) if( $t->root);
  4022.  
  4023.     return $dump;
  4024.     
  4025.   }
  4026.  
  4027. 1;
  4028.  
  4029. ######################################################################
  4030. package XML::Twig::Entity_list;
  4031. ######################################################################
  4032. use UNIVERSAL qw(isa);
  4033.  
  4034. sub new
  4035.   { my $class = shift;
  4036.     my $self={ entities => {}, updated => 0};
  4037.  
  4038.     bless $self, $class;
  4039.     return $self;
  4040.  
  4041.   }
  4042.  
  4043. sub add_new_ent
  4044.   { my $ent_list= shift;
  4045.     my $ent= XML::Twig::Entity->new( @_);
  4046.     $ent_list->add( $ent);
  4047.     return $ent_list;
  4048.   }
  4049.  
  4050. sub _add_list
  4051.   { my( $ent_list, $to_add)= @_;
  4052.     my $ents_to_add= $to_add->{entities};
  4053.     return $ent_list unless( $ents_to_add && %$ents_to_add);
  4054.     @{$ent_list->{entities}}{keys %$ents_to_add}= values %$ents_to_add;
  4055.     $ent_list->{updated}=1;
  4056.     return $ent_list;
  4057.   }
  4058.  
  4059. sub add
  4060.   { my( $ent_list, $ent)= @_;
  4061.     $ent_list->{entities}->{$ent->{name}}= $ent;
  4062.     $ent_list->{updated}=1;
  4063.     return $ent_list;
  4064.   }
  4065.  
  4066. sub ent
  4067.   { my( $ent_list, $ent_name)= @_;
  4068.     return $ent_list->{entities}->{$ent_name};
  4069.   }
  4070.  
  4071. # can be called with an entity or with an entity name
  4072. sub delete
  4073.   { my $ent_list= shift;
  4074.     if( isa( ref $_[0], 'XML::Twig::Entity'))
  4075.       { # the second arg is an entity
  4076.         my $ent= shift;
  4077.         delete $ent_list->{entities}->{$ent->{name}};
  4078.       }
  4079.     else
  4080.       { # the second arg was not entity, must be a string then
  4081.         my $name= shift;
  4082.         delete $ent_list->{entities}->{$name};
  4083.       }
  4084.     $ent_list->{updated}=1;
  4085.     return $ent_list;
  4086.   }
  4087.  
  4088. sub print
  4089.   { my ($ent_list, $fh)= @_;
  4090.     my $old_select= defined $fh ? select $fh : undef;
  4091.  
  4092.     foreach my $ent_name ( sort keys %{$ent_list->{entities}})
  4093.       { my $ent= $ent_list->{entities}->{$ent_name};
  4094.         # we have to test what the entity is or un-defined entities can creep in
  4095.         $ent->print() if( isa( $ent, 'XML::Twig::Entity'));
  4096.       }
  4097.     select $old_select if( defined $old_select);
  4098.     return $ent_list;
  4099.   }
  4100.  
  4101. sub text
  4102.   { my ($ent_list)= @_;
  4103.     return join "\n", map { $ent_list->{entities}->{$_}->text} sort keys %{$ent_list->{entities}};
  4104.   }
  4105.  
  4106. # return the list of entity names 
  4107. sub entity_names($)
  4108.   { my $ent_list= shift;
  4109.     return sort keys %{$ent_list->{entities}} ;
  4110.   }
  4111.  
  4112.  
  4113. sub list
  4114.   { my ($ent_list)= @_;
  4115.     return map { $ent_list->{entities}->{$_} } sort keys %{$ent_list->{entities}};
  4116.   }
  4117.  
  4118. 1;
  4119.  
  4120. ######################################################################
  4121. package XML::Twig::Entity;
  4122. ######################################################################
  4123. use UNIVERSAL qw(isa);
  4124.  
  4125. sub new
  4126.   { my( $class, $name, $val, $sysid, $pubid, $ndata, $param)= @_;
  4127.     $class= ref( $class) || $class;
  4128.  
  4129.     my $self={};
  4130.     
  4131.     $self->{name}  = $name;
  4132.     $self->{val}   = $val   if( defined $val  );
  4133.     $self->{sysid} = $sysid if( defined $sysid);
  4134.     $self->{pubid} = $pubid if( defined $pubid);
  4135.     $self->{ndata} = $ndata if( defined $ndata);
  4136.     $self->{param} = $param if( defined $param);
  4137.  
  4138.     bless $self, $class;
  4139.     return $self;
  4140.   }
  4141.  
  4142.  
  4143. sub name  { return $_[0]->{name}; }
  4144. sub val   { return $_[0]->{val}; }
  4145. sub sysid { return defined( $_[0]->{sysid}) ? $_[0]->{sysid} : ''; }
  4146. sub pubid { return defined( $_[0]->{pubid}) ? $_[0]->{pubid} : ''; }
  4147. sub ndata { return defined( $_[0]->{ndata}) ? $_[0]->{ndata} : ''; }
  4148. sub param { return defined( $_[0]->{param}) ? $_[0]->{param} : ''; }
  4149.  
  4150.  
  4151. sub print
  4152.   { my ($ent, $fh)= @_;
  4153.     my $text= $ent->text;
  4154.     if( !defined( $text)) { $text=''; }
  4155.     if( $fh) { print $fh $text . "\n"; }
  4156.     else     { print $text . "\n"; }
  4157.   }
  4158.  
  4159. sub sprint
  4160.   { my ($ent)= @_;
  4161.     my $text= $ent->text;
  4162.     if( !defined( $text)) { $text=''; }
  4163.     return $text;
  4164.   }
  4165. sub text
  4166.   { my ($ent)= @_;
  4167.     #warn "text called: '", $ent->_dump, "'\n";
  4168.     return '' if( !$ent->{name});
  4169.     my @tokens;
  4170.     push @tokens, '<!ENTITY';
  4171.    
  4172.     push @tokens, '%' if( $ent->{param});
  4173.     push @tokens, $ent->{name};
  4174.  
  4175.     if( defined $ent->{val} && !defined( $ent->{sysid}) && !defined($ent->{pubid}) )
  4176.       { push @tokens, _quoted_val( $ent->{val});
  4177.       }
  4178.     elsif( defined $ent->{sysid})
  4179.       { push @tokens, 'PUBLIC', _quoted_val( $ent->{pubid}) if( $ent->{pubid});
  4180.         push @tokens, 'SYSTEM' unless( $ent->{pubid});
  4181.         push @tokens, _quoted_val( $ent->{sysid}); 
  4182.         push @tokens, 'NDATA', $ent->{ndata} if( $ent->{ndata});
  4183.       }
  4184.     return join( ' ', @tokens) . '>';
  4185.   }
  4186.  
  4187. sub _quoted_val
  4188.   { my $q= $_[0]=~ m{"} ? q{'} : q{"};
  4189.     return qq{$q$_[0]$q};
  4190.   }
  4191.  
  4192. sub _dump
  4193.   { my( $ent)= @_; return join( " - ", map { "$_ => '$ent->{$_}'" } grep { defined $ent->{$_} } sort keys %$ent); }
  4194.                 
  4195. 1;
  4196.  
  4197. ######################################################################
  4198. package XML::Twig::Elt;
  4199. ######################################################################
  4200. use Carp;
  4201.  
  4202. use UNIVERSAL qw(isa);
  4203.  
  4204. use constant  PCDATA  => '#PCDATA'; 
  4205. use constant  CDATA   => '#CDATA'; 
  4206. use constant  PI      => '#PI'; 
  4207. use constant  COMMENT => '#COMMENT'; 
  4208. use constant  ENT     => '#ENT'; 
  4209.  
  4210. use constant  ASIS    => '#ASIS';    # pcdata elements not to be XML-escaped
  4211.  
  4212. use constant  ELT     => '#ELT'; 
  4213. use constant  TEXT    => '#TEXT'; 
  4214. use constant  EMPTY   => '#EMPTY'; 
  4215.  
  4216. use constant CDATA_START    => "<![CDATA[";
  4217. use constant CDATA_END      => "]]>";
  4218. use constant PI_START       => "<?";
  4219. use constant PI_END         => "?>";
  4220. use constant COMMENT_START  => "<!--";
  4221. use constant COMMENT_END    => "-->";
  4222.  
  4223. use constant XMLNS_URI      => 'http://www.w3.org/2000/xmlns/';
  4224. my $XMLNS_URI               = XMLNS_URI;
  4225.  
  4226.  
  4227. BEGIN
  4228.   { # set some aliases for methods
  4229.     *tag           = *gi; 
  4230.     *name          = *gi; 
  4231.     *set_tag       = *set_gi; 
  4232.     *set_name      = *set_gi; 
  4233.     *find_nodes    = *get_xpath; # as in XML::DOM
  4234.     *findnodes     = *get_xpath; # as in XML::LibXML
  4235.     *field         = *first_child_text;
  4236.     *trimmed_field = *first_child_trimmed_text;
  4237.     *is_field      = *contains_only_text;
  4238.     *is            = *passes;
  4239.     *matches       = *passes;
  4240.     *has_child     = *first_child;
  4241.     *has_children  = *first_child;
  4242.     *all_children_pass = *all_children_are;
  4243.     *all_children_match= *all_children_are;
  4244.     *getElementsByTagName= *descendants;
  4245.     *find_by_tag_name= *descendants_or_self;
  4246.     *unwrap          = *erase;
  4247.     *inner_xml       = *xml_string;
  4248.     *outer_xml       = *sprint;
  4249.   
  4250.     *first_child_is  = *first_child_matches;
  4251.     *last_child_is   = *last_child_matches;
  4252.     *next_sibling_is = *next_sibling_matches;
  4253.     *prev_sibling_is = *prev_sibling_matches;
  4254.     *next_elt_is     = *next_elt_matches;
  4255.     *prev_elt_is     = *prev_elt_matches;
  4256.     *parent_is       = *parent_matches;
  4257.     *child_is        = *child_matches;
  4258.     *inherited_att   = *inherit_att;
  4259.  
  4260.     *sort_children_by_value= *sort_children_on_value;
  4261.  
  4262.     *has_atts= *att_nb;
  4263.  
  4264.     # imports from XML::Twig
  4265.     *_is_fh= *XML::Twig::_is_fh;
  4266.  
  4267.     # XML::XPath compatibility
  4268.     *string_value       = *text;
  4269.     *toString           = *sprint;
  4270.     *getName            = *gi;
  4271.     *getRootNode        = *twig;  
  4272.     *getNextSibling     = *_next_sibling;
  4273.     *getPreviousSibling = *_prev_sibling;
  4274.     *isElementNode      = *is_elt;
  4275.     *isTextNode         = *is_text;
  4276.     *isPI               = *is_pi;
  4277.     *isPINode           = *is_pi;
  4278.     *isProcessingInstructionNode= *is_pi;
  4279.     *isComment          = *is_comment;
  4280.     *isCommentNode      = *is_comment;
  4281.     *getTarget          = *target;
  4282.     *getFirstChild      = *_first_child;
  4283.     *getLastChild      = *_last_child;
  4284.  
  4285.     # try using weak references
  4286.     # test whether we can use weak references
  4287.     { local $SIG{__DIE__};
  4288.       if( eval 'require Scalar::Util' && defined( &Scalar::Util::weaken) )
  4289.         { import Scalar::Util qw(weaken); }
  4290.       elsif( eval 'require WeakRef')
  4291.         { import WeakRef; }
  4292.     }
  4293. }
  4294.  
  4295.  
  4296. # can be called as XML::Twig::Elt->new( [[$gi, $atts, [@content]])
  4297. # - gi is an optional gi given to the element
  4298. # - $atts is a hashref to attributes for the element
  4299. # - @content is an optional list of text and elements that will
  4300. #   be inserted under the element 
  4301. sub new 
  4302.   { my $class= shift;
  4303.     $class= ref $class || $class;
  4304.     my $elt  = {};
  4305.     bless ($elt, $class);
  4306.  
  4307.     return $elt unless @_;
  4308.  
  4309.     # if a gi is passed then use it
  4310.     my $gi= shift;
  4311.     $elt->set_gi( $gi);
  4312.  
  4313.  
  4314.     my $atts= ref $_[0] eq 'HASH' ? shift : undef;
  4315.  
  4316.     if( $atts && defined $atts->{'#CDATA'})
  4317.       { delete $atts->{'#CDATA'};
  4318.  
  4319.         my $cdata= new( $class, '#CDATA', @_);
  4320.         return new( $class, $gi, $atts, $cdata);
  4321.       }
  4322.  
  4323.     if( $gi eq PCDATA)
  4324.       { if( grep { ref $_ } @_) { croak "element #PCDATA can only be created from text"; }
  4325.         $elt->_set_pcdata( join( '', @_)); 
  4326.       }
  4327.     elsif( $gi eq ENT)
  4328.       { $elt->{ent}=  shift; }
  4329.     elsif( $gi eq CDATA)
  4330.       { if( grep { ref $_ } @_) { croak "element #CDATA can only be created from text"; }
  4331.         $elt->_set_cdata( join( '', @_)); 
  4332.       }
  4333.     elsif( $gi eq COMMENT)
  4334.       { if( grep { ref $_ } @_) { croak "element #COMMENT can only be created from text"; }
  4335.         $elt->_set_comment( join( '', @_)); 
  4336.       }
  4337.     elsif( $gi eq PI)
  4338.       { if( grep { ref $_ } @_) { croak "element #PI can only be created from text"; }
  4339.         $elt->_set_pi( shift, join( '', @_));
  4340.       }
  4341.     else
  4342.       { # the rest of the arguments are the content of the element
  4343.         if( @_)
  4344.           { $elt->set_content( @_); }
  4345.         else
  4346.           { $elt->{empty}=  1;    }
  4347.       }
  4348.  
  4349.     if( $atts)
  4350.       { # the attribute hash can be used to pass the asis status 
  4351.         if( defined $atts->{'#ASIS'})  { $elt->set_asis(  $atts->{'#ASIS'} ); delete $atts->{'#ASIS'};  }
  4352.         if( defined $atts->{'#EMPTY'}) { $elt->{empty}=  $atts->{'#EMPTY'}; delete $atts->{'#EMPTY'}; }
  4353.         $elt->set_atts( $atts) if( keys %$atts);
  4354.         $elt->_set_id( $atts->{$ID}) if( $atts->{$ID});
  4355.       }
  4356.  
  4357.     return $elt;
  4358.   }
  4359.  
  4360. # this function creates an XM:::Twig::Elt from a string
  4361. # it is quite clumsy at the moment, as it just creates a
  4362. # new twig then returns its root
  4363. # there might also be memory leaks there
  4364. # additional arguments are passed to new XML::Twig
  4365. sub parse
  4366.   { my $class= shift;
  4367.     if( ref( $class)) { $class= ref( $class); }
  4368.     my $string= shift;
  4369.     my %args= @_;
  4370.     my $t= XML::Twig->new(%args);
  4371.     $t->parse( $string);
  4372.     my $elt= $t->root;
  4373.     # clean-up the node 
  4374.     delete $elt->{twig};         # get rid of the twig data
  4375.     delete $elt->{twig_current}; # better get rid of this too
  4376.     if( $t->{twig_id_list}) { $elt->{twig_id_list}= $t->{twig_id_list}; }
  4377.     return $elt;
  4378.   }
  4379.    
  4380. sub set_inner_xml
  4381.   { my( $elt, $xml)= @_;
  4382.     my $new_elt= $elt->parse( "<dummy>$xml</dummy>");
  4383.     $elt->cut_children;
  4384.     $new_elt->paste_first_child( $elt);
  4385.     $new_elt->erase;
  4386.     return $elt;
  4387.   }
  4388.   
  4389. sub set_inner_html
  4390.   { my( $elt, $html)= @_;
  4391.     my $t= XML::Twig->new->parse_html( "<html>$html</html>");
  4392.     my $new_elt= $t->root;
  4393.     if( $elt->tag eq 'head')
  4394.       { $new_elt->first_child( 'head')->unwrap;
  4395.         $new_elt->first_child( 'body')->cut;
  4396.       }
  4397.     elsif( $elt->tag ne 'html')
  4398.       { $new_elt->first_child( 'head')->cut;
  4399.         $new_elt->first_child( 'body')->unwrap;
  4400.       }
  4401.     $new_elt->cut;
  4402.     $elt->cut_children;
  4403.     $new_elt->paste_first_child( $elt);
  4404.     $new_elt->erase;
  4405.     return $elt;
  4406.   }
  4407.  
  4408. sub set_gi 
  4409.   { my ($elt, $gi)= @_;
  4410.     unless( defined $XML::Twig::gi2index{$gi})
  4411.       { # new gi, create entries in %gi2index and @index2gi
  4412.         push  @XML::Twig::index2gi, $gi;
  4413.         $XML::Twig::gi2index{$gi}= $#XML::Twig::index2gi;
  4414.       }
  4415.     $elt->{gi}= $XML::Twig::gi2index{$gi};
  4416.     return $elt; 
  4417.   }
  4418.  
  4419. sub gi  { return $XML::Twig::index2gi[$_[0]->{gi}]; }
  4420.  
  4421. sub local_name 
  4422.   { my $elt= shift;
  4423.     return _local_name( $XML::Twig::index2gi[$elt->{'gi'}]);
  4424.   }
  4425.  
  4426. sub ns_prefix
  4427.   { my $elt= shift;
  4428.     return _ns_prefix( $XML::Twig::index2gi[$elt->{'gi'}]);
  4429.   }
  4430.  
  4431. # namespace prefix for any qname (can be used for elements or attributes)
  4432. sub _ns_prefix
  4433.   { my $qname= shift;
  4434.     if( $qname=~ m{^([^:]*):})
  4435.       { return $1; }
  4436.     else
  4437.       { return( ''); } # should it be '' ?
  4438.   }
  4439.  
  4440. # local name for any qname (can be used for elements or attributes)
  4441. sub _local_name
  4442.   { my $qname= shift;
  4443.     (my $local= $qname)=~ s{^[^:]*:}{};
  4444.     return $local;
  4445.   }
  4446.  
  4447. BEGIN 
  4448.   { my %DEFAULT_NS= ( xml   => "http://www.w3.org/XML/1998/namespace",
  4449.                       xmlns => "http://www.w3.org/2000/xmlns/",
  4450.                     );
  4451.  
  4452.     #sub get_namespace
  4453.     sub namespace
  4454.       { my $elt= shift;
  4455.         my $prefix= defined $_[0] ? shift() : $elt->ns_prefix;
  4456.         my $ns_att= $prefix ? "xmlns:$prefix" : "xmlns";
  4457.         my $expanded= $DEFAULT_NS{$prefix} || $elt->_inherit_att_through_cut( $ns_att) || '';
  4458.         return $expanded;
  4459.       }
  4460.  
  4461.     sub declare_missing_ns
  4462.       { my $root= shift;
  4463.         my %missing_prefix;
  4464.         my $map= $root->_twig_through_cut->{twig_map_xmlns};
  4465.         foreach my $elt ( $root->descendants)
  4466.           { if( my $prefix= $elt->ns_prefix)
  4467.               { warn "checking prefix '$prefix'\n";
  4468.                 if(  !$missing_prefix{$prefix} && !$elt->namespace)
  4469.                   { $missing_prefix{$prefix}=1; warn "missing $prefix\n"; }
  4470.               }
  4471.           }
  4472.         foreach my $prefix (keys %missing_prefix)
  4473.           { if( ! $root->_inherits_declared_prefix( $prefix))
  4474.               { $root->set_ns_decl( $prefix, $map->{$prefix}); }
  4475.           }
  4476.         return $root;
  4477.       }
  4478.  
  4479.   }
  4480.  
  4481. sub _inherits_declared_prefix
  4482.    { my( $elt, $prefix)= @_;
  4483.      while( $elt) 
  4484.        { if( $elt->_declares_prefix( $prefix))
  4485.            { return 1; }
  4486.          else
  4487.            { $elt= $elt->{parent}; }
  4488.       }
  4489.     return 0;
  4490.  }
  4491.  
  4492. sub _declares_prefix
  4493.  { my( $elt, $prefix)= @_;
  4494.    foreach my $att ($elt->att_names) { return 1 if( $att eq "xmlns:$prefix"); }
  4495.     return 0;
  4496.  }
  4497.  
  4498. sub set_ns_decl
  4499.   { my( $elt, $uri, $prefix)= @_;
  4500.     my $ns_att=  $prefix ? "xmlns:$prefix" : 'xmlns';
  4501.     $elt->set_att( $ns_att => $uri);
  4502.   }
  4503.  
  4504. sub set_ns_as_default
  4505.   { my( $root, $uri)= @_;
  4506.     $root->set_ns_decl( $uri);
  4507.     foreach my $elt ($root->descendants_or_self)
  4508.       { if( $elt->_ns_prefix && $elt->namespace eq $uri) 
  4509.           { $elt->set_tag( $elt->local_name); }
  4510.         #foreach my $att ($elt->att_names)
  4511.         #  { if( my $prefix= _ns_prefix( $att) )
  4512.         #      { if( $elt->namespace( $prefix) eq $uri) 
  4513.         #          { $elt->change_att_name( $att, _local_name( $att)); }
  4514.         #  }
  4515.       }
  4516.   }
  4517.      
  4518.  
  4519.  
  4520. # return #ELT for an element and #PCDATA... for others
  4521. sub get_type
  4522.   { my $gi_nb= $_[0]->{gi}; # the number, not the string
  4523.     return ELT if( $gi_nb >= $XML::Twig::SPECIAL_GI);
  4524.     return $_[0]->gi;
  4525.   }
  4526.  
  4527. # return the gi if it's a "real" element, 0 otherwise
  4528. sub is_elt
  4529.   { return $_[0]->gi if(  $_[0]->{gi} >=  $XML::Twig::SPECIAL_GI);
  4530.     return 0;
  4531.   }
  4532.  
  4533.  
  4534. sub is_pcdata
  4535.   { my $elt= shift;
  4536.     return (exists $elt->{'pcdata'});
  4537.   }
  4538.  
  4539. sub is_cdata
  4540.   { my $elt= shift;
  4541.     return (exists $elt->{'cdata'});
  4542.   }
  4543.  
  4544. sub is_pi
  4545.   { my $elt= shift;
  4546.     return (exists $elt->{'target'});
  4547.   }
  4548.  
  4549. sub is_comment
  4550.   { my $elt= shift;
  4551.     return (exists $elt->{'comment'});
  4552.   }
  4553.  
  4554. sub is_ent
  4555.   { my $elt= shift;
  4556.     return (exists $elt->{ent} || $elt->{ent_name});
  4557.   }
  4558.  
  4559.  
  4560. sub is_text
  4561.   { my $elt= shift;
  4562.     return (exists( $elt->{'pcdata'}) || (exists $elt->{'cdata'}));
  4563.   }
  4564.  
  4565. sub is_empty
  4566.   { return $_[0]->{empty} || 0; }
  4567.  
  4568. sub set_empty
  4569.   { $_[0]->{empty}= defined( $_[1]) ? $_[1] : 1; return $_[0]; }
  4570.  
  4571. sub set_not_empty
  4572.   { delete $_[0]->{empty} if( ($_[0]->{'empty'} || 0)); return $_[0]; }
  4573.  
  4574.  
  4575. sub set_asis
  4576.   { my $elt=shift;
  4577.  
  4578.     foreach my $descendant ($elt, $elt->_descendants )
  4579.       { $descendant->{asis}= 1;
  4580.         if( (exists $descendant->{'cdata'}))
  4581.           { $descendant->set_gi( PCDATA);
  4582.             $descendant->_set_pcdata( $descendant->{cdata});
  4583.           }
  4584.  
  4585.       }
  4586.     return $elt;
  4587.   }
  4588.  
  4589. sub set_not_asis
  4590.   { my $elt=shift;
  4591.     foreach my $descendant ($elt, $elt->descendants)
  4592.       { delete $descendant->{asis} if $descendant->{asis};}
  4593.     return $elt;
  4594.   }
  4595.  
  4596. sub is_asis
  4597.   { return $_[0]->{asis}; }
  4598.  
  4599. sub closed 
  4600.   { my $elt= shift;
  4601.     my $t= $elt->twig || return;
  4602.     my $curr_elt= $t->{twig_current};
  4603.     return 1 unless( $curr_elt);
  4604.     return $curr_elt->in( $elt);
  4605.   }
  4606.  
  4607. sub set_pcdata 
  4608.   { my( $elt, $pcdata)= @_;
  4609.   
  4610.     if( $elt->_extra_data_in_pcdata)
  4611.       { _try_moving_extra_data( $elt, $pcdata);
  4612.       }
  4613.     delete $elt->{empty};
  4614.     $elt->{pcdata}= $pcdata;
  4615.     return $elt; 
  4616.   }
  4617.  
  4618. sub _extra_data_in_pcdata      { return $_[0]->{extra_data_in_pcdata}; }
  4619. sub _set_extra_data_in_pcdata  { $_[0]->{extra_data_in_pcdata}= $_[1]; return $_[0]; }
  4620. sub _del_extra_data_in_pcdata  { delete $_[0]->{extra_data_in_pcdata}; return $_[0]; }
  4621. sub _unshift_extra_data_in_pcdata { unshift @{shift()->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; }
  4622. sub _push_extra_data_in_pcdata    { push @{shift()->{extra_data_in_pcdata}},    { text => shift(), offset => shift() }; }
  4623.  
  4624. sub _extra_data_before_end_tag     { return $_[0]->{extra_data_before_end_tag} || ''; }
  4625. sub _set_extra_data_before_end_tag { $_[0]->{extra_data_before_end_tag}= $_[1]; return $_[0]}
  4626. sub _del_extra_data_before_end_tag { delete $_[0]->{extra_data_before_end_tag}; return $_[0]}
  4627. sub _prefix_extra_data_before_end_tag 
  4628.   { my( $elt, $data)= @_;
  4629.     if($elt->{extra_data_before_end_tag})
  4630.       { $elt->{extra_data_before_end_tag}= $data . $elt->{extra_data_before_end_tag}; }
  4631.     else  
  4632.       { $elt->{extra_data_before_end_tag}= $data; }
  4633.     return $elt;
  4634.   }
  4635.  
  4636. # internal, in cases where we know there is no extra_data (inlined anyway!)
  4637. sub _set_pcdata { $_[0]->{pcdata}= $_[1]; }
  4638.  
  4639. # try to figure out if we can keep the extra_data around
  4640. sub _try_moving_extra_data
  4641.   { my( $elt, $modified)=@_;
  4642.     my $initial= $elt->{pcdata};
  4643.     my $cpis= $elt->_extra_data_in_pcdata;
  4644.  
  4645.     if( (my $offset= index( $modified, $initial)) != -1) 
  4646.       { # text has been added
  4647.         foreach (@$cpis) { $_->{offset}+= $offset; }
  4648.       }
  4649.     elsif( ($offset= index( $initial, $modified)) != -1)
  4650.       { # text has been cut
  4651.         my $len= length( $modified);
  4652.         foreach my $cpi (@$cpis) { $cpi->{offset} -= $offset; }
  4653.         $elt->_set_extra_data_in_pcdata( [ grep { $_->{offset} >= 0 && $_->{offset} < $len } @$cpis ]);
  4654.       } 
  4655.     else
  4656.       {    _match_extra_data_words( $elt, $initial, $modified)
  4657.         || _match_extra_data_chars( $elt, $initial, $modified)
  4658.         || $elt->_del_extra_data_in_pcdata;
  4659.       }
  4660.   }
  4661.  
  4662. sub _match_extra_data_words
  4663.   { my( $elt, $initial, $modified)= @_;
  4664.     my @initial= split /\b/, $initial; 
  4665.     my @modified= split /\b/, $modified;
  4666.        
  4667.     return _match_extra_data( $elt, length( $initial), \@initial, \@modified);
  4668.   }
  4669.   
  4670. sub _match_extra_data_chars
  4671.   { my( $elt, $initial, $modified)= @_;
  4672.     my @initial= split //, $initial; 
  4673.     my @modified= split //, $modified;
  4674.        
  4675.     return _match_extra_data( $elt, length( $initial), \@initial, \@modified);
  4676.   }
  4677.  
  4678. sub _match_extra_data
  4679.   { my( $elt, $length, $initial, $modified)= @_;
  4680.         
  4681.     my $cpis= $elt->_extra_data_in_pcdata;
  4682.  
  4683.     if( @$initial <= @$modified)
  4684.       { 
  4685.         my( $ok, $positions, $offsets)= _pos_offset( $initial, $modified);
  4686.         if( $ok) 
  4687.           { my $offset=0;
  4688.             my $pos= shift @$positions;
  4689.             foreach my $cpi (@$cpis)
  4690.               { while( $cpi->{offset} >= $pos)
  4691.                   { $offset= shift @$offsets; 
  4692.                     $pos= shift @$positions || $length +1;
  4693.                   }
  4694.                 $cpi->{offset} += $offset;
  4695.               }
  4696.             return 1;
  4697.           }
  4698.       }
  4699.     else
  4700.       { my( $ok, $positions, $offsets)= _pos_offset( $modified, $initial);
  4701.         if( $ok)
  4702.           { #print STDERR "pos:    ", join( ':', @$positions), "\n",
  4703.             #             "offset: ", join( ':', @$offsets), "\n";
  4704.             my $offset=0;
  4705.             my $pos= shift @$positions;
  4706.             my $prev_pos= 0;
  4707.             
  4708.             foreach my $cpi (@$cpis)
  4709.               { while( $cpi->{offset} >= $pos)
  4710.                   { $offset= shift @$offsets;
  4711.                     $prev_pos= $pos;
  4712.                     $pos= shift @$positions || $length +1;
  4713.                   }
  4714.                 $cpi->{offset} -= $offset;
  4715.                 if( $cpi->{offset} < $prev_pos) { delete $cpi->{text}; }
  4716.               }
  4717.             $elt->_set_extra_data_in_pcdata( [ grep { exists $_->{text} } @$cpis ]);
  4718.             return 1;
  4719.           }
  4720.       }
  4721.     return 0;
  4722.   }
  4723.  
  4724.           
  4725. sub _pos_offset
  4726.   { my( $short, $long)= @_;
  4727.     my( @pos, @offset);
  4728.     my( $s_length, $l_length)=(0,0);
  4729.     while (@$short)
  4730.       { my $s_word= shift @$short;
  4731.         my $l_word= shift @$long;
  4732.         if( $s_word ne $l_word)
  4733.           { while( @$long && $s_word ne $l_word)
  4734.               { $l_length += length( $l_word);
  4735.                 $l_word= shift @$long;
  4736.               }
  4737.             if( !@$long && $s_word ne $l_word) { return 0; }
  4738.             push @pos, $s_length;
  4739.             push @offset, $l_length - $s_length;
  4740.           }
  4741.         my $length= length( $s_word);
  4742.         $s_length += $length;
  4743.         $l_length += $length;
  4744.       }
  4745.     return( 1, \@pos, \@offset);
  4746.   }
  4747.  
  4748. sub append_pcdata
  4749.   { delete $_[0]->{empty};
  4750.     $_[0]->{'pcdata'}.= $_[1];
  4751.     return $_[0]; 
  4752.   }
  4753.  
  4754. sub pcdata        { return $_[0]->{pcdata}; }
  4755.  
  4756.  
  4757. sub append_extra_data 
  4758.   {  $_[0]->{extra_data}.= $_[1];
  4759.      return $_[0]; 
  4760.   }
  4761.   
  4762. sub set_extra_data 
  4763.   { $_[0]->{extra_data}= $_[1];
  4764.     return $_[0]; 
  4765.   }
  4766. sub extra_data { return $_[0]->{extra_data} || ''; }
  4767.  
  4768. sub set_target 
  4769.   { my( $elt, $target)= @_;
  4770.     $elt->{target}= $target;
  4771.     return $elt; 
  4772.   }
  4773. sub target { return $_[0]->{target}; }
  4774.  
  4775. sub set_data 
  4776.   { $_[0]->{'data'}= $_[1]; 
  4777.     return $_[0];
  4778.   }
  4779. sub data { return $_[0]->{data}; }
  4780.  
  4781. sub set_pi
  4782.   { my $elt= shift;
  4783.     unless( $elt->{gi} == $XML::Twig::gi2index{'#PI'})
  4784.       { $elt->cut_children;
  4785.         $elt->set_gi( '#PI');
  4786.       }
  4787.     return $elt->_set_pi( @_);
  4788.   }
  4789.  
  4790. sub _set_pi
  4791.   { $_[0]->{target}=  $_[1];
  4792.     $_[0]->{data}=  $_[2];
  4793.     return $_[0]; 
  4794.   }
  4795.  
  4796. sub pi_string { my $string= PI_START . $_[0]->{target};
  4797.                 my $data= $_[0]->{data};
  4798.                 if( defined( $data) && $data ne '') { $string .= " $data"; }
  4799.                 $string .= PI_END ;
  4800.                 return $string;
  4801.               }
  4802.  
  4803. sub set_comment
  4804.   { my $elt= shift;
  4805.     unless( $elt->{gi} == $XML::Twig::gi2index{'#COMMENT'})
  4806.       { $elt->cut_children;
  4807.         $elt->set_gi( '#COMMENT');
  4808.       }
  4809.     return $elt->_set_comment( @_);
  4810.   }
  4811.  
  4812. sub _set_comment   { $_[0]->{comment}= $_[1]; return $_[0]; }
  4813. sub comment        { return $_[0]->{comment}; }
  4814. sub comment_string { return COMMENT_START . $_[0]->{comment} . COMMENT_END; }
  4815.  
  4816. sub set_ent  { $_[0]->{ent}= $_[1]; return $_[0]; }
  4817. sub ent      { return $_[0]->{ent}; }
  4818. sub ent_name { return substr( $_[0]->{ent}, 1, -1);}
  4819.  
  4820. sub set_cdata 
  4821.   { my $elt= shift;
  4822.     unless( $elt->{gi} == $XML::Twig::gi2index{'#CDATA'})
  4823.       { $elt->cut_children;
  4824.         $elt->insert_new_elt( first_child => '#CDATA', @_);
  4825.         return $elt;
  4826.       }
  4827.     return $elt->_set_cdata( @_);
  4828.   }
  4829.   
  4830. sub _set_cdata 
  4831.   { delete $_[0]->{empty};
  4832.     $_[0]->{cdata}= $_[1]; 
  4833.     return $_[0];
  4834.   }
  4835.  
  4836. sub append_cdata
  4837.   { $_[0]->{cdata}.= $_[1]; 
  4838.     return $_[0];
  4839.   }
  4840. sub cdata { return $_[0]->{cdata}; }
  4841.  
  4842.  
  4843. #start-extract twig_node
  4844. sub contains_only_text
  4845.   { my $elt= shift;
  4846.     return 0 unless $elt->is_elt;
  4847.     foreach my $child ($elt->_children)
  4848.       { return 0 if $child->is_elt; }
  4849.     return $elt;
  4850.   } 
  4851.   
  4852. sub contains_only
  4853.   { my( $elt, $exp)= @_;
  4854.     my @children= $elt->_children;
  4855.     foreach my $child (@children)
  4856.       { return 0 unless $child->is( $exp); }
  4857.     return @children || 1;
  4858.   } 
  4859.  
  4860. sub contains_a_single
  4861.   { my( $elt, $exp)= @_;
  4862.     my $child= $elt->{first_child} or return 0;
  4863.     return 0 unless $child->matches( $exp);
  4864.     return 0 if( $child->{next_sibling});
  4865.     return $child;
  4866.   } 
  4867.  
  4868.  
  4869. sub root 
  4870.   { my $elt= shift;
  4871.     while( $elt->{parent}) { $elt= $elt->{parent}; }
  4872.     return $elt;
  4873.   }
  4874.  
  4875. sub _root_through_cut
  4876.   { my $elt= shift;
  4877.     while( $elt->{parent} || $elt->former_parent) { $elt= $elt->{parent} || $elt->former_parent; }
  4878.     return $elt;
  4879.   }
  4880.  
  4881. sub twig 
  4882.   { my $elt= shift;
  4883.     my $root= $elt->root;
  4884.     return $root->{twig};
  4885.   }
  4886.  
  4887. sub _twig_through_cut
  4888.   { my $elt= shift;
  4889.     my $root= $elt->_root_through_cut;
  4890.     return $root->{twig};
  4891.   }
  4892.  
  4893.  
  4894. #start-extract twig_node
  4895.  
  4896. # returns undef or the element, depending on whether $elt passes $cond
  4897. # $cond can be
  4898. # - empty: the element passes the condition
  4899. # - ELT ('#ELT'): the element passes the condition if it is a "real" element
  4900. # - TEXT ('#TEXT'): the element passes if it is a CDATA or PCDATA element
  4901. # - a string with an XPath condition (only a subset of XPath is actually
  4902. #   supported).
  4903. # - a regexp: the element passes if its gi matches the regexp
  4904. # - a code ref: the element passes if the code, applied on the element,
  4905. #   returns true
  4906.  
  4907. my %cond_cache; # expression => coderef
  4908.  
  4909. sub reset_cond_cache { %cond_cache=(); }
  4910.  
  4911.    sub _install_cond
  4912.     { my $cond= shift;
  4913.       my $test;
  4914.       my $init='';
  4915.  
  4916.       my $original_cond= $cond;
  4917.  
  4918.       my $not= ($cond=~ s{^\s*!}{}) ? '!' : '';
  4919.  
  4920.       if( ref $cond eq 'CODE') { return $cond; }
  4921.     
  4922.       if( ref $cond eq 'Regexp')
  4923.         { $test = qq{(\$_[0]->gi=~ /$cond/)}; }
  4924.       else
  4925.         { # the condition is a string
  4926.           if( $cond eq ELT)     
  4927.             { $test = qq{\$_[0]->is_elt}; }
  4928.           elsif( $cond eq TEXT) 
  4929.             { $test = qq{\$_[0]->is_text}; }
  4930.           elsif( $cond=~ m{^\s*($REG_NAME_W)\s*$}o)                  
  4931.             { # gi
  4932.               if( $1 ne '*')
  4933.                 { # 2 options, depending on whether the gi exists in gi2index
  4934.                   # start optimization
  4935.                   my $gi= $XML::Twig::gi2index{$1};
  4936.                   if( $gi)
  4937.                     { # the gi exists, use its index as a faster shortcut
  4938.                       $test = qq{ \$_[0]->{gi} == $XML::Twig::gi2index{$1}};
  4939.                     }
  4940.                   else
  4941.                   # end optimization
  4942.                     { # it does not exist (but might be created later), compare the strings
  4943.                       $test = qq{ \$_[0]->gi eq "$1"}; 
  4944.                     }
  4945.                 }
  4946.               else
  4947.                 { $test = qq{ (1) } }
  4948.             }
  4949.           elsif( $cond=~ m{^\s*($REG_REGEXP)\s*$}o)
  4950.             { # /regexp/
  4951.               $test = qq{ \$_[0]->gi=~ $1 }; 
  4952.             }
  4953.           elsif( $cond=~ m{^\s*($REG_NAME_W)?\s*  # $1
  4954.                            \[\s*(-?)\s*(\d+)\s*\] #   [$2]
  4955.                            \s*$}xo
  4956.                )
  4957.             { my( $gi, $neg, $index)= ($1, $2, $3);
  4958.               my $siblings= $neg ? q{$_[0]->_next_siblings} : q{$_[0]->_prev_siblings};
  4959.               if( $gi && ($gi ne '*')) 
  4960.                 { $test= qq{((\$_[0]->gi eq "$gi") && (scalar( grep { \$_->gi eq "$gi" } $siblings) + 1 == $index))}; }
  4961.               else
  4962.                 { $test= qq{(scalar( $siblings) + 1 == $index)}; }
  4963.             }
  4964.           elsif( $cond=~ m{^\s*\.([\w-]+)\s*$}o)
  4965.             { # .class
  4966.               my $class= $1;
  4967.               $test = qq{(\$_[0]->in_class( "$class")) }; 
  4968.             }
  4969.           elsif( $cond=~ m{^\s*($REG_NAME_W?)\s*($REG_PREDICATE)\s*$})
  4970.             { my( $tag, $predicate)= ( $1, $2);
  4971.               $test= ( $tag && $tag ne '*') ? qq{ (\$_[0]->gi eq "$tag") && } : '';
  4972.               $test .=   _parse_predicate_in_step( $predicate);
  4973.             }
  4974.           elsif( $cond=~ m{^\s*($REG_NAKED_PREDICATE)\s*$})
  4975.             { $test .=   _parse_predicate_in_step( $1); }
  4976.           else
  4977.             { croak "wrong navigation condition '$original_cond' ($@)"; }
  4978.         }
  4979.  
  4980.       #warn "init: '$init' - test: '$test'\n";
  4981.  
  4982.       my $sub= qq{sub { $init; return $not($test) ? \$_[0] : undef; } };
  4983.       my $s= eval $sub; 
  4984.       #warn "cond: $cond\n$sub\n";
  4985.       if( $@) 
  4986.         { croak "wrong navigation condition '$original_cond' ($@);" }
  4987.       return $s;
  4988.     }
  4989.  
  4990.   # input: the original predicate
  4991.   sub _parse_predicate_in_step
  4992.     { my $cond= shift; 
  4993.       my %PERL_ALPHA_TEST= ( '=' => ' eq ', '!=' => ' ne ', '>' => ' gt ', '>=' => ' ge ', '<' => ' lt ', '<=' => ' le ');
  4994.  
  4995.       $cond=~ s{^\s*\[\s*}{};
  4996.       $cond=~ s{\s*\]\s*$}{};
  4997.       $cond=~ s{(   ($REG_STRING)                        # strings
  4998.                    |\@($REG_NAME)(?=\s*(?:[><=!]|!~|=~)) # @att (followed by a comparison operator)
  4999.                    |\@($REG_NAME)                        # @att (not followed by a comparison operator)
  5000.                    |=~|!~                                # matching operators
  5001.                    |([><]=?|=|!=)(?=\s*[\d+-])           # test before a number
  5002.                    |([><]=?|=|!=)                        # test, other cases
  5003.                    |($REG_FUNCTION)                      # no arg functions
  5004.                    # this bit is a mess, but it is the only solution with this half-baked parser
  5005.                    |((?:string|text)\(\s*$REG_NAME\s*\)\s*$REG_MATCH\s*$REG_REGEXP) # string( child) =~ /regexp/
  5006.                    |((?:string|text)\(\s*$REG_NAME\s*\)\s*!?=\s*$REG_VALUE)         # string( child) = "value" (or !=)
  5007.                    |((?:string|text)\(\s*$REG_NAME\s*\)\s*[<>]=?\s*$REG_VALUE)      # string( child) > "value"
  5008.                    |(and|or)
  5009.                 )}
  5010.                { my( $token, $string, $att, $bare_att, $num_test, $alpha_test, $func, $string_regexp, $string_eq, $string_test, $and_or)
  5011.                  = ( $1,     $2,      $3,   $4,        $5,        $6,          $7,    $8,             $9,         $10,          $11);
  5012.       
  5013.                  if( defined $string)   { $token }
  5014.                  elsif( $att)           { "( \$_[0]->{att} && exists( \$_[0]->{att}->{'$att'}) && \$_[0]->{att}->{'$att'})"; }
  5015.                  elsif( $bare_att)      { "(\$_[0]->{att} && defined( \$_[0]->{att}->{'$bare_att'}))"; }
  5016.                  elsif( $num_test && ($num_test eq '=') ) { "==" } # others tests are unchanged
  5017.                  elsif( $alpha_test)    { $PERL_ALPHA_TEST{$alpha_test} }
  5018.                  elsif( $func && $func=~ m{^(?:string|text)})
  5019.                                         { "\$_[0]->text"; }
  5020.                  elsif( $string_regexp && $string_regexp =~ m{(?:string|text)\(\s*($REG_NAME)\s*\)\s*($REG_MATCH)\s*($REG_REGEXP)})
  5021.                                         { "(XML::Twig::_first_n { (\$_->gi eq '$1') && (\$_->text $2 $3) } 1, \$_[0]->_children)"; }
  5022.                  elsif( $string_eq     && $string_eq     =~ m{(?:string|text)\(\s*($REG_NAME)\s*\)\s*(!?=)\s*($REG_VALUE)})
  5023.                                         {"(XML::Twig::_first_n { (\$_->gi eq '$1') && (\$_->text $PERL_ALPHA_TEST{$2} $3) } 1, \$_[0]->_children)"; }
  5024.                  elsif( $string_test   && $string_test   =~ m{(?:string|text)\(\s*($REG_NAME)\s*\)\s*([<>]=?)\s*($REG_VALUE)})
  5025.                                         { "(XML::Twig::_first_n { (\$_->gi eq '$1') && (\$_->text $2 $3) } 1, \$_[0]->_children)"; }
  5026.                  elsif( $and_or)        { $and_or eq 'and' ? '&&' : '||' ; }
  5027.                  else                   { $token; }
  5028.                }gexs;
  5029.       return "($cond)";
  5030.     }
  5031.   
  5032.  
  5033.   sub _op
  5034.     { my $op= shift;
  5035.       if(    $op eq '=')  { $op= 'eq'; }
  5036.       elsif( $op eq '!=') { $op= 'ne'; }
  5037.       return $op;
  5038.     }
  5039.  
  5040.   sub passes
  5041.     { my( $elt, $cond)= @_;
  5042.       return $elt unless $cond;
  5043.       my $sub= ($cond_cache{$cond} ||= _install_cond( $cond));
  5044.       return $sub->( $elt);
  5045.     }
  5046. }
  5047. # end-extract twig_nodes
  5048.  
  5049. sub set_parent 
  5050.   { $_[0]->{parent}= $_[1];
  5051.     weaken( $_[0]->{parent}) if( $XML::Twig::weakrefs);
  5052.   }
  5053.  
  5054. #start-extract twig_node
  5055. sub parent
  5056.   { my $elt= shift;
  5057.     my $cond= shift || return $elt->{parent};
  5058.     do { $elt= $elt->{parent} || return; } until (!$elt || $elt->passes( $cond));
  5059.     return $elt;
  5060.   }
  5061. #end-extract twig_node
  5062.  
  5063. sub set_first_child 
  5064.   { delete $_[0]->{empty};
  5065.     $_[0]->{'first_child'}= $_[1]; 
  5066.   }
  5067.  
  5068. #start-extract twig_node
  5069. sub first_child
  5070.   { my $elt= shift;
  5071.     my $cond= shift || return $elt->{first_child};
  5072.     my $child= $elt->{first_child};
  5073.     my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
  5074.     while( $child && !$test_cond->( $child)) 
  5075.        { $child= $child->{next_sibling}; }
  5076.     return $child;
  5077.   }
  5078. #end-extract twig_node
  5079.   
  5080. sub _first_child   { return $_[0]->{first_child};  }
  5081. sub _last_child    { return $_[0]->{last_child};   }
  5082. sub _next_sibling  { return $_[0]->{next_sibling}; }
  5083. sub _prev_sibling  { return $_[0]->{prev_sibling}; }
  5084. sub _parent        { return $_[0]->{parent};       }
  5085. sub _next_siblings { my $elt= shift; my @siblings; while( $elt= $elt->{next_sibling}) { push @siblings, $elt; } return @siblings; }
  5086. sub _prev_siblings { my $elt= shift; my @siblings; while( $elt= $elt->{prev_sibling}) { push @siblings, $elt; } return @siblings; }
  5087.  
  5088. # sets a field
  5089. # arguments $record, $cond, @content
  5090. sub set_field
  5091.   { my $record = shift;
  5092.     my $cond = shift;
  5093.     my $child= $record->first_child( $cond);
  5094.     if( $child)
  5095.       { $child->set_content( @_); }
  5096.     else
  5097.       { if( $cond=~ m{^\s*($REG_NAME)})
  5098.           { my $gi= $1;
  5099.             $child= $record->insert_new_elt( last_child => $gi, @_); 
  5100.           }
  5101.         else
  5102.           { croak "can't create a field name from $cond"; }
  5103.       } 
  5104.     return $child;
  5105.   }
  5106.  
  5107. sub set_last_child 
  5108.   { delete $_[0]->{empty};
  5109.     $_[0]->{'last_child'}= $_[1];
  5110.     weaken( $_[0]->{'last_child'}) if( $XML::Twig::weakrefs);
  5111.   }
  5112.  
  5113. #start-extract twig_node
  5114. sub last_child
  5115.   { my $elt= shift;
  5116.     my $cond= shift || return $elt->{last_child};
  5117.     my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
  5118.     my $child= $elt->{last_child};
  5119.     while( $child && !$test_cond->( $child) )
  5120.       { $child= $child->{prev_sibling}; }
  5121.     return $child
  5122.   }
  5123. #end-extract twig_node
  5124.  
  5125.  
  5126. sub set_prev_sibling 
  5127.   { $_[0]->{'prev_sibling'}= $_[1]; 
  5128.     weaken( $_[0]->{'prev_sibling'}) if( $XML::Twig::weakrefs); 
  5129.   }
  5130.  
  5131. #start-extract twig_node
  5132. sub prev_sibling
  5133.   { my $elt= shift;
  5134.     my $cond= shift || return $elt->{prev_sibling};
  5135.     my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
  5136.     my $sibling= $elt->{prev_sibling};
  5137.     while( $sibling && !$test_cond->( $sibling) )
  5138.           { $sibling= $sibling->{prev_sibling}; }
  5139.     return $sibling;
  5140.   }
  5141. #end-extract twig_node
  5142.  
  5143. sub set_next_sibling { $_[0]->{'next_sibling'}= $_[1]; }
  5144.  
  5145. #start-extract twig_node
  5146. sub next_sibling
  5147.   { my $elt= shift;
  5148.     my $cond= shift || return $elt->{next_sibling};
  5149.     my $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond));
  5150.     my $sibling= $elt->{next_sibling};
  5151.     while( $sibling && !$test_cond->( $sibling) )
  5152.           { $sibling= $sibling->{next_sibling}; }
  5153.     return $sibling;
  5154.   }
  5155.  
  5156. # methods dealing with the class attribute, convenient if you work with xhtml
  5157. sub class     { my( $elt)= @_; return $elt->{'att'}->{'class'}; }
  5158. sub set_class { my( $elt, $class)= @_; $elt->set_att( class => $class); }
  5159.  
  5160. # adds a class to an element
  5161. sub add_to_class
  5162.   { my( $elt, $new_class)= @_;
  5163.     return $elt unless $new_class;
  5164.     my $class= $elt->class;
  5165.     my %class= $class ? map { $_ => 1 } split /\s+/, $class : ();
  5166.     $class{$new_class}= 1;
  5167.     $elt->set_class( join( ' ', sort keys %class));
  5168.   }
  5169.  
  5170. sub att_to_class      { my( $elt, $att)= @_; $elt->set_class( $elt->{'att'}->{$att}); }
  5171. sub add_att_to_class  { my( $elt, $att)= @_; $elt->add_to_class( $elt->{'att'}->{$att}); }
  5172. sub move_att_to_class { my( $elt, $att)= @_; $elt->add_to_class( $elt->{'att'}->{$att});
  5173.                         $elt->del_att( $att); 
  5174.                       }
  5175. sub tag_to_class      { my( $elt)= @_; $elt->set_class( $elt->tag);    }
  5176. sub add_tag_to_class  { my( $elt)= @_; $elt->add_to_class( $elt->tag); }
  5177. sub set_tag_class     { my( $elt, $new_tag)= @_; $elt->add_tag_to_class; $elt->set_tag( $new_tag); }
  5178.  
  5179. sub tag_to_span       
  5180.   { my( $elt)= @_; 
  5181.     $elt->set_class( $elt->tag) unless( $elt->tag eq 'span' && $elt->class); # set class to span unless it would mean replacing it with span
  5182.     $elt->set_tag( 'span'); 
  5183.   }
  5184.  
  5185. sub tag_to_div    
  5186.   { my( $elt)= @_; 
  5187.     $elt->set_class( $elt->tag) unless( $elt->tag eq 'div' && $elt->class); # set class to div unless it would mean replacing it with div
  5188.     $elt->set_tag( 'div');
  5189.   }
  5190.  
  5191. sub in_class          
  5192.   { my( $elt, $class)= @_;
  5193.     my $elt_class= $elt->class;
  5194.     return unless( defined $elt_class);
  5195.     return $elt->class=~ m{(?:^|\s)\Q$class\E(?:\s|$)} ? $elt : 0;
  5196.   }
  5197.  
  5198.  
  5199. #end-extract twig_node
  5200.  
  5201. # get or set all attributes
  5202. # argument can be a hash or a hashref
  5203. sub set_atts 
  5204.   { my $elt= shift;
  5205.     my %atts;
  5206.     tie %atts, 'Tie::IxHash' if( keep_atts_order());
  5207.     %atts= ( isa( $_[0] || '', 'HASH')) ? %{$_[0]} : @_;
  5208.     $elt->{att}= \%atts;
  5209.     if( exists $atts{$ID}) { $elt->_set_id( $atts{$ID}); }
  5210.     return $elt;
  5211.   }
  5212.  
  5213. sub atts      { return $_[0]->{att};           }
  5214. sub att_names { return sort keys %{$_[0]->{att}};   }
  5215. sub del_atts  { $_[0]->{att}={}; return $_[0]; }
  5216.  
  5217. # get or set a single attribute (set works for several atts)
  5218. sub set_att 
  5219.   { my $elt= shift;
  5220.     
  5221.     unless( $elt->{att})
  5222.       { $elt->{att}={};
  5223.         tie %{$elt->{att}}, 'Tie::IxHash' if( keep_atts_order());
  5224.       }
  5225.  
  5226.     while(@_) 
  5227.       { my( $att, $val)= (shift, shift);
  5228.         $elt->{att}->{$att}= $val;
  5229.         if( $att eq $ID) { $elt->_set_id( $val); } 
  5230.       }
  5231.     return $elt;
  5232.   }
  5233.  
  5234. sub att { return $_[0]->{att}->{$_[1]}; }
  5235. sub del_att 
  5236.   { my $elt= shift;
  5237.     while( @_) { delete $elt->{'att'}->{shift()}; }
  5238.     return $elt;
  5239.   }
  5240.  
  5241. # delete an attribute from all descendants of an element
  5242. sub strip_att
  5243.   { my( $elt, $att)= @_;
  5244.     $_->del_att( $att) foreach ($elt->descendants_or_self( qq{*[\@$att]}));
  5245.     return $elt;
  5246.   }
  5247.  
  5248. sub change_att_name
  5249.   { my( $elt, $old_name, $new_name)= @_;
  5250.     my $value= $elt->{'att'}->{$old_name};
  5251.     return $elt unless( defined $value);
  5252.     $elt->del_att( $old_name)
  5253.         ->set_att( $new_name => $value);
  5254.     return $elt;
  5255.   }
  5256.  
  5257. sub set_twig_current { $_[0]->{twig_current}=1; }
  5258. sub del_twig_current { delete $_[0]->{twig_current}; }
  5259.  
  5260.  
  5261. # get or set the id attribute
  5262. sub set_id 
  5263.   { my( $elt, $id)= @_;
  5264.     $elt->del_id() if( exists $elt->{att}->{$ID});
  5265.     $elt->set_att($ID, $id); 
  5266.     $elt->_set_id( $id);
  5267.     return $elt;
  5268.   }
  5269.  
  5270. # only set id, does not update the attribute value
  5271. sub _set_id
  5272.   { my( $elt, $id)= @_;
  5273.     my $t= $elt->twig || $elt;
  5274.     $t->{twig_id_list}->{$id}= $elt;
  5275.     weaken(  $t->{twig_id_list}->{$id}) if( $XML::Twig::weakrefs);
  5276.     return $elt;
  5277.   }
  5278.  
  5279. sub id { return $_[0]->{att}->{$ID}; }
  5280.  
  5281. # methods used to add ids to elements that don't have one
  5282. BEGIN 
  5283. { my $id_nb   = "0001";
  5284.   my $id_seed = "twig_id_";
  5285.  
  5286.   sub set_id_seed
  5287.     { $id_seed= $_[1]; $id_nb=1; }
  5288.  
  5289.   sub add_id
  5290.     { my $elt= shift; 
  5291.       if( defined $elt->{'att'}->{$ID})
  5292.         { return $elt->{'att'}->{$ID}; }
  5293.       else
  5294.         { $elt->set_id( $_[0] && isa( $_[0], 'CODE') ? $_[0]->( $elt) : $id_seed . $id_nb++); }
  5295.     }
  5296. }
  5297.  
  5298.  
  5299.  
  5300. # delete the id attribute and remove the element from the id list
  5301. sub del_id 
  5302.   { my $elt= shift;
  5303.     unless( exists $elt->{'att'}) { return $elt }; 
  5304.     unless( exists $elt->{'att'}->{$ID}) { return $elt }; 
  5305.     my $id= $elt->{'att'}->{$ID};
  5306.  
  5307.     delete $elt->{'att'}->{$ID}; 
  5308.  
  5309.     my $t= shift || $elt->twig;
  5310.     unless( $t) { return $elt; }
  5311.     if( exists $t->{twig_id_list}->{$id}) { delete $t->{twig_id_list}->{$id}; }
  5312.  
  5313.     return $elt;
  5314.   }
  5315.  
  5316. # return the list of children
  5317. #start-extract twig_node
  5318. sub children
  5319.   { my $elt= shift;
  5320.     my @children;
  5321.     my $child= $elt->first_child( @_);
  5322.     while( $child) 
  5323.       { push @children, $child;
  5324.         $child= $child->next_sibling( @_);
  5325.       } 
  5326.     return @children;
  5327.   }
  5328.  
  5329. sub _children
  5330.   { my $elt= shift;
  5331.     my @children=();
  5332.     my $child= $elt->_first_child();
  5333.     while( $child) 
  5334.       { push @children, $child;
  5335.         $child= $child->{next_sibling};
  5336.       } 
  5337.     return @children;
  5338.   }
  5339.  
  5340. sub children_copy
  5341.   { my $elt= shift;
  5342.     my @children;
  5343.     my $child= $elt->first_child( @_);
  5344.     while( $child) 
  5345.       { push @children, $child->copy;
  5346.         $child= $child->next_sibling( @_);
  5347.       } 
  5348.     return @children;
  5349.   }
  5350.  
  5351.  
  5352. sub children_count
  5353.   { my $elt= shift;
  5354.     my $cond= shift;
  5355.     my $count=0;
  5356.     my $child= $elt->{first_child};
  5357.     while( $child)
  5358.       { $count++ if( $child->passes( $cond)); 
  5359.         $child= $child->{next_sibling};
  5360.       }
  5361.     return $count;
  5362.   }
  5363.  
  5364. sub children_text
  5365.   { my $elt= shift;
  5366.     return wantarray() ? map { $_->text} $elt->children( @_)
  5367.                        : join( '', map { $_->text} $elt->children( @_) )
  5368.                        ;
  5369.   }
  5370.  
  5371. sub children_trimmed_text
  5372.   { my $elt= shift;
  5373.     return wantarray() ? map { $_->trimmed_text} $elt->children( @_)
  5374.                        : join( '', map { $_->trimmed_text} $elt->children( @_) )
  5375.                        ;
  5376.   }
  5377.  
  5378. sub all_children_are
  5379.   { my( $parent, $cond)= @_;
  5380.     foreach my $child ($parent->_children)
  5381.       { return 0 unless( $child->passes( $cond)); }
  5382.     return 1;
  5383.   }
  5384.  
  5385.  
  5386. sub ancestors
  5387.   { my( $elt, $cond)= @_;
  5388.     my @ancestors;
  5389.     while( $elt->{parent})
  5390.       { $elt= $elt->{parent};
  5391.         push @ancestors, $elt if( $elt->passes( $cond));
  5392.       }
  5393.     return @ancestors;
  5394.   }
  5395.  
  5396. sub ancestors_or_self
  5397.   { my( $elt, $cond)= @_;
  5398.     my @ancestors;
  5399.     while( $elt)
  5400.       { push @ancestors, $elt if( $elt->passes( $cond));
  5401.         $elt= $elt->{parent};
  5402.       }
  5403.     return @ancestors;
  5404.   }
  5405.  
  5406.  
  5407. sub _ancestors
  5408.   { my( $elt, $include_self)= @_;
  5409.     my @ancestors= $include_self ? ($elt) : ();
  5410.     while( $elt= $elt->{parent}) { push @ancestors, $elt; }
  5411.     return @ancestors;
  5412.   }
  5413.  
  5414.  
  5415. sub inherit_att
  5416.   { my $elt= shift;
  5417.     my $att= shift;
  5418.     my %tags= map { ($_, 1) } @_;
  5419.  
  5420.     do 
  5421.       { if(   (defined $elt->{'att'}->{$att})
  5422.            && ( !%tags || $tags{$XML::Twig::index2gi[$elt->{'gi'}]})
  5423.           )
  5424.           { return $elt->{'att'}->{$att}; }
  5425.       } while( $elt= $elt->{parent});
  5426.     return undef;
  5427.   }
  5428.  
  5429. sub _inherit_att_through_cut
  5430.   { my $elt= shift;
  5431.     my $att= shift;
  5432.     my %tags= map { ($_, 1) } @_;
  5433.  
  5434.     do 
  5435.       { if(   (defined $elt->{'att'}->{$att})
  5436.            && ( !%tags || $tags{$XML::Twig::index2gi[$elt->{'gi'}]})
  5437.           )
  5438.           { return $elt->{'att'}->{$att}; }
  5439.       } while( $elt= $elt->{parent} || $elt->former_parent);
  5440.     return undef;
  5441.   }
  5442.  
  5443.  
  5444. sub current_ns_prefixes
  5445.   { my $elt= shift;
  5446.     my %prefix;
  5447.     $prefix{''}=1 if( $elt->namespace( ''));
  5448.     while( $elt)
  5449.       { my @ns= grep { !m{^xml} } map { m{^([^:]+):} } ($XML::Twig::index2gi[$elt->{'gi'}], $elt->att_names);
  5450.         $prefix{$_}=1 foreach (@ns);
  5451.         $elt= $elt->{parent};
  5452.       }
  5453.  
  5454.     return sort keys %prefix;
  5455.   }
  5456.  
  5457. # kinda counter-intuitive actually:
  5458. # the next element is found by looking for the next open tag after from the
  5459. # current one, which is the first child, if it exists, or the next sibling
  5460. # or the first next sibling of an ancestor
  5461. # optional arguments are: 
  5462. #   - $subtree_root: a reference to an element, when the next element is not 
  5463. #                    within $subtree_root anymore then next_elt returns undef
  5464. #   - $cond: a condition, next_elt returns the next element matching the condition
  5465.                  
  5466. sub next_elt
  5467.   { my $elt= shift;
  5468.     my $subtree_root= 0;
  5469.     $subtree_root= shift if( defined $_[0] and (isa( $_[0], 'XML::Twig::Elt')));
  5470.     my $cond= shift;
  5471.     my $next_elt;
  5472.  
  5473.     my $ind;                                                              # optimization
  5474.     my $test_cond;
  5475.     if( $cond)                                                            # optimization
  5476.       { unless( defined( $ind= $XML::Twig::gi2index{$cond}) )             # optimization
  5477.           { $test_cond= ($cond_cache{$cond} ||= _install_cond( $cond)); } # optimization
  5478.       }                                                                   # optimization
  5479.     
  5480.     do
  5481.       { if( $next_elt= $elt->{first_child})
  5482.           { # simplest case: the elt has a child
  5483.           }
  5484.          elsif( $next_elt= $elt->{next_sibling}) 
  5485.           { # no child but a next sibling (just check we stay within the subtree)
  5486.           
  5487.             # case where elt is subtree_root, is empty and has a sibling
  5488.             return undef if( $subtree_root && ($elt == $subtree_root));
  5489.             
  5490.           }
  5491.         else
  5492.           { # case where the element has no child and no next sibling:
  5493.             # get the first next sibling of an ancestor, checking subtree_root 
  5494.           
  5495.             # case where elt is subtree_root, is empty and has no sibling
  5496.             return undef if( $subtree_root && ($elt == $subtree_root));
  5497.              
  5498.             $next_elt= $elt->{parent};
  5499.  
  5500.             until( $next_elt->{next_sibling})
  5501.               { return undef if( $subtree_root && ($subtree_root == $next_elt));
  5502.                 $next_elt= $next_elt->{parent} || return undef;
  5503.               }
  5504.             return undef if( $subtree_root && ($subtree_root == $next_elt)); 
  5505.             $next_elt= $next_elt->{next_sibling};   
  5506.           }  
  5507.       $elt= $next_elt;                   # just in case we need to loop
  5508.     } until(    ! defined $elt 
  5509.              || ! defined $cond 
  5510.          || (defined $ind       && ($elt->{gi} eq $ind))   # optimization
  5511.          || (defined $test_cond && ($test_cond->( $elt)))
  5512.                );
  5513.     
  5514.       return $elt;
  5515.       }
  5516.  
  5517. # return the next_elt within the element
  5518. # just call next_elt with the element as first and second argument
  5519. sub first_descendant { return $_[0]->next_elt( @_); }
  5520.  
  5521. # get the last descendant, # then return the element found or call prev_elt with the condition
  5522. sub last_descendant
  5523.   { my( $elt, $cond)= @_;
  5524.     my $last_descendant= $elt->_last_descendant;
  5525.     if( !$cond || $last_descendant->matches( $cond))
  5526.       { return $last_descendant; }
  5527.     else
  5528.       { return $last_descendant->prev_elt( $elt, $cond); }
  5529.   }
  5530.  
  5531. # no argument allowed here, just go down the last_child recursively
  5532. sub _last_descendant
  5533.   { my $elt= shift;
  5534.     while( my $child= $elt->{last_child}) { $elt= $child; }
  5535.     return $elt;
  5536.   }
  5537.  
  5538. # counter-intuitive too:
  5539. # the previous element is found by looking
  5540. # for the first open tag backwards from the current one
  5541. # it's the last descendant of the previous sibling 
  5542. # if it exists, otherwise it's simply the parent
  5543. sub prev_elt
  5544.   { my $elt= shift;
  5545.     my $subtree_root= 0;
  5546.     if( defined $_[0] and (isa( $_[0], 'XML::Twig::Elt')))
  5547.       { $subtree_root= shift ;
  5548.         return undef if( $elt == $subtree_root);
  5549.       }
  5550.     my $cond= shift;
  5551.     # get prev elt
  5552.     my $prev_elt;
  5553.     do
  5554.       { return undef if( $elt == $subtree_root);
  5555.         if( $prev_elt= $elt->{prev_sibling})
  5556.           { while( $prev_elt->{last_child})
  5557.               { $prev_elt= $prev_elt->{last_child}; }
  5558.           }
  5559.         else
  5560.           { $prev_elt= $elt->{parent} || return undef; }
  5561.         $elt= $prev_elt;     # in case we need to loop 
  5562.       } until( $elt->passes( $cond));
  5563.  
  5564.     return $elt;
  5565.   }
  5566.  
  5567. sub _following_elt
  5568.   { my( $elt)= @_;
  5569.     while( $elt && !$elt->{next_sibling})
  5570.       { $elt= $elt->{parent}; }
  5571.     return $elt ? $elt->{next_sibling} : undef;
  5572.   }
  5573.  
  5574. sub following_elt
  5575.   { my( $elt, $cond)= @_;
  5576.     $elt= $elt->_following_elt || return undef;
  5577.     return $elt if( !$cond || $elt->matches( $cond));
  5578.     return $elt->next_elt( $cond);
  5579.   }
  5580.  
  5581. sub following_elts
  5582.   { my( $elt, $cond)= @_;
  5583.     if( !$cond) { $cond= undef; }
  5584.     my $following= $elt->following_elt( $cond);
  5585.     if( $following)
  5586.       { my @followings= $following;
  5587.         while( $following= $following->next_elt( $cond))
  5588.           { push @followings, $following; }
  5589.         return( @followings);
  5590.       }
  5591.     else
  5592.       { return (); }
  5593.   }
  5594.  
  5595. sub _preceding_elt
  5596.   { my( $elt)= @_;
  5597.     while( $elt && !$elt->{prev_sibling})
  5598.       { $elt= $elt->{parent}; }
  5599.     return $elt ? $elt->{prev_sibling}->_last_descendant : undef;
  5600.   }
  5601.  
  5602. sub preceding_elt
  5603.   { my( $elt, $cond)= @_;
  5604.     $elt= $elt->_preceding_elt || return undef;
  5605.     return $elt if( !$cond || $elt->matches( $cond));
  5606.     return $elt->prev_elt( $cond);
  5607.   }
  5608.  
  5609. sub preceding_elts
  5610.   { my( $elt, $cond)= @_;
  5611.     if( !$cond) { $cond= undef; }
  5612.     my $preceding= $elt->preceding_elt( $cond);
  5613.     if( $preceding)
  5614.       { my @precedings= $preceding;
  5615.         while( $preceding= $preceding->prev_elt( $cond))
  5616.           { push @precedings, $preceding; }
  5617.         return( @precedings);
  5618.       }
  5619.     else
  5620.       { return (); }
  5621.   }
  5622.  
  5623. # used in get_xpath
  5624. sub _self
  5625.   { my( $elt, $cond)= @_;
  5626.     return $cond ? $elt->matches( $cond) : $elt;
  5627.   }
  5628.  
  5629. sub next_n_elt
  5630.   { my $elt= shift;
  5631.     my $offset= shift || return undef;
  5632.     foreach (1..$offset)
  5633.       { $elt= $elt->next_elt( @_) || return undef; }
  5634.     return $elt;
  5635.   }
  5636.  
  5637. # checks whether $elt is included in $ancestor, returns 1 in that case
  5638. sub in
  5639.   { my ($elt, $ancestor)= @_;
  5640.     if( isa( $ancestor, 'XML::Twig::Elt'))
  5641.       { # element
  5642.         while( $elt= $elt->{parent}) { return $elt if( $elt ==  $ancestor); } 
  5643.       }
  5644.     else
  5645.       { # condition
  5646.         while( $elt= $elt->{parent}) { return $elt if( $elt->matches( $ancestor)); } 
  5647.       }
  5648.     return 0;           
  5649.   }
  5650.  
  5651. sub first_child_text  
  5652.   { my $elt= shift;
  5653.     my $dest=$elt->first_child(@_) or return '';
  5654.     return $dest->text;
  5655.   }
  5656.  
  5657. sub fields  
  5658.   { my $elt= shift;
  5659.     return map { $elt->field( $_) } @_;
  5660.   }
  5661.  
  5662. sub first_child_trimmed_text  
  5663.   { my $elt= shift;
  5664.     my $dest=$elt->first_child(@_) or return '';
  5665.     return $dest->trimmed_text;
  5666.   }
  5667.   
  5668. sub first_child_matches
  5669.   { my $elt= shift;
  5670.     my $dest= $elt->{first_child} or return undef;
  5671.     return $dest->passes( @_);
  5672.   }
  5673.   
  5674. sub last_child_text  
  5675.   { my $elt= shift;
  5676.     my $dest=$elt->last_child(@_) or return '';
  5677.     return $dest->text;
  5678.   }
  5679.   
  5680. sub last_child_trimmed_text  
  5681.   { my $elt= shift;
  5682.     my $dest=$elt->last_child(@_) or return '';
  5683.     return $dest->trimmed_text;
  5684.   }
  5685.   
  5686. sub last_child_matches
  5687.   { my $elt= shift;
  5688.     my $dest= $elt->{last_child} or return undef;
  5689.     return $dest->passes( @_);
  5690.   }
  5691.   
  5692. sub child_text
  5693.   { my $elt= shift;
  5694.     my $dest=$elt->child(@_) or return '';
  5695.     return $dest->text;
  5696.   }
  5697.   
  5698. sub child_trimmed_text
  5699.   { my $elt= shift;
  5700.     my $dest=$elt->child(@_) or return '';
  5701.     return $dest->trimmed_text;
  5702.   }
  5703.   
  5704. sub child_matches
  5705.   { my $elt= shift;
  5706.     my $nb= shift;
  5707.     my $dest= $elt->child( $nb) or return undef;
  5708.     return $dest->passes( @_);
  5709.   }
  5710.  
  5711. sub prev_sibling_text  
  5712.   { my $elt= shift;
  5713.     my $dest=$elt->_prev_sibling(@_) or return '';
  5714.     return $dest->text;
  5715.   }
  5716.   
  5717. sub prev_sibling_trimmed_text  
  5718.   { my $elt= shift;
  5719.     my $dest=$elt->_prev_sibling(@_) or return '';
  5720.     return $dest->trimmed_text;
  5721.   }
  5722.   
  5723. sub prev_sibling_matches
  5724.   { my $elt= shift;
  5725.     my $dest= $elt->{prev_sibling} or return undef;
  5726.     return $dest->passes( @_);
  5727.   }
  5728.   
  5729. sub next_sibling_text  
  5730.   { my $elt= shift;
  5731.     my $dest=$elt->next_sibling(@_) or return '';
  5732.     return $dest->text;
  5733.   }
  5734.   
  5735. sub next_sibling_trimmed_text  
  5736.   { my $elt= shift;
  5737.     my $dest=$elt->next_sibling(@_) or return '';
  5738.     return $dest->trimmed_text;
  5739.   }
  5740.   
  5741. sub next_sibling_matches
  5742.   { my $elt= shift;
  5743.     my $dest= $elt->{next_sibling} or return undef;
  5744.     return $dest->passes( @_);
  5745.   }
  5746.   
  5747. sub prev_elt_text  
  5748.   { my $elt= shift;
  5749.     my $dest=$elt->prev_elt(@_) or return '';
  5750.     return $dest->text;
  5751.   }
  5752.   
  5753. sub prev_elt_trimmed_text  
  5754.   { my $elt= shift;
  5755.     my $dest=$elt->prev_elt(@_) or return '';
  5756.     return $dest->trimmed_text;
  5757.   }
  5758.   
  5759. sub prev_elt_matches
  5760.   { my $elt= shift;
  5761.     my $dest= $elt->prev_elt or return undef;
  5762.     return $dest->passes( @_);
  5763.   }
  5764.   
  5765. sub next_elt_text  
  5766.   { my $elt= shift;
  5767.     my $dest=$elt->next_elt(@_) or return '';
  5768.     return $dest->text;
  5769.   }
  5770.   
  5771. sub next_elt_trimmed_text  
  5772.   { my $elt= shift;
  5773.     my $dest=$elt->next_elt(@_) or return '';
  5774.     return $dest->trimmed_text;
  5775.   }
  5776.   
  5777. sub next_elt_matches
  5778.   { my $elt= shift;
  5779.     my $dest= $elt->next_elt or return undef;
  5780.     return $dest->passes( @_);
  5781.   }
  5782.   
  5783. sub parent_text  
  5784.   { my $elt= shift;
  5785.     my $dest=$elt->parent(@_) or return '';
  5786.     return $dest->text;
  5787.   }
  5788.   
  5789. sub parent_trimmed_text  
  5790.   { my $elt= shift;
  5791.     my $dest=$elt->parent(@_) or return '';
  5792.     return $dest->trimmed_text;
  5793.   }
  5794.   
  5795. sub parent_matches
  5796.   { my $elt= shift;
  5797.     my $dest= $elt->{parent} or return undef;
  5798.     return $dest->passes( @_);
  5799.   }
  5800.  
  5801. sub is_first_child
  5802.   { my $elt= shift;
  5803.     my $parent= $elt->{parent} or return 0;
  5804.     my $first_child= $parent->first_child( @_) or return 0;
  5805.     return ($first_child == $elt) ? $elt : 0;
  5806.   }
  5807.  
  5808. sub is_last_child
  5809.   { my $elt= shift;
  5810.     my $parent= $elt->{parent} or return 0;
  5811.     my $last_child= $parent->last_child( @_) or return 0;
  5812.     return ($last_child == $elt) ? $elt : 0;
  5813.   }
  5814.  
  5815. # returns the depth level of the element
  5816. # if 2 parameter are used then counts the 2cd element name in the
  5817. # ancestors list
  5818. sub level
  5819.   { my( $elt, $cond)= @_;
  5820.     my $level=0;
  5821.     my $name=shift || '';
  5822.     while( $elt= $elt->{parent}) { $level++ if( !$cond || $elt->matches( $cond)); }
  5823.     return $level;           
  5824.   }
  5825.  
  5826. # checks whether $elt has an ancestor that satisfies $cond, returns the ancestor
  5827. sub in_context
  5828.   { my ($elt, $cond, $level)= @_;
  5829.     $level= -1 unless( $level) ;  # $level-- will never hit 0
  5830.  
  5831.     while( $level)
  5832.       { $elt= $elt->{parent} or return 0;
  5833.         if( $elt->matches( $cond)) { return $elt; }
  5834.         $level--;
  5835.       }
  5836.     return 0;
  5837.   }
  5838.  
  5839. sub _descendants
  5840.   { my( $subtree_root, $include_self)= @_;
  5841.     my @descendants= $include_self ? ($subtree_root) : ();
  5842.  
  5843.     my $elt= $subtree_root; 
  5844.     my $next_elt;   
  5845.  
  5846.     MAIN: while( 1)  
  5847.       { if( $next_elt= $elt->{first_child})
  5848.           { # simplest case: the elt has a child
  5849.           }
  5850.         elsif( $next_elt= $elt->{next_sibling}) 
  5851.           { # no child but a next sibling (just check we stay within the subtree)
  5852.           
  5853.             # case where elt is subtree_root, is empty and has a sibling
  5854.             last MAIN if( $elt == $subtree_root);
  5855.           }
  5856.         else
  5857.           { # case where the element has no child and no next sibling:
  5858.             # get the first next sibling of an ancestor, checking subtree_root 
  5859.                 
  5860.             # case where elt is subtree_root, is empty and has no sibling
  5861.             last MAIN if( $elt == $subtree_root);
  5862.                
  5863.             # backtrack until we find a parent with a next sibling
  5864.             $next_elt= $elt->{parent} || last;
  5865.             until( $next_elt->{next_sibling})
  5866.               { last MAIN if( $subtree_root == $next_elt);
  5867.                 $next_elt= $next_elt->{parent} || last MAIN;
  5868.               }
  5869.             last MAIN if( $subtree_root == $next_elt); 
  5870.             $next_elt= $next_elt->{next_sibling};   
  5871.           }  
  5872.         $elt= $next_elt || last MAIN;
  5873.         push @descendants, $elt;
  5874.       }
  5875.     return @descendants;
  5876.   }
  5877.  
  5878.  
  5879. sub descendants
  5880.   { my( $subtree_root, $cond)= @_;
  5881.     my @descendants=(); 
  5882.     my $elt= $subtree_root;
  5883.     
  5884.     # this branch is pure optimization for speed: if $cond is a gi replace it
  5885.     # by the index of the gi and loop here 
  5886.     # start optimization
  5887.     my $ind;
  5888.     if( !$cond || ( defined ( $ind= $XML::Twig::gi2index{$cond})) )
  5889.       {
  5890.         my $next_elt;
  5891.  
  5892.         while( 1)  
  5893.           { if( $next_elt= $elt->{first_child})
  5894.                 { # simplest case: the elt has a child
  5895.                 }
  5896.              elsif( $next_elt= $elt->{next_sibling}) 
  5897.               { # no child but a next sibling (just check we stay within the subtree)
  5898.            
  5899.                 # case where elt is subtree_root, is empty and has a sibling
  5900.                 last if( $subtree_root && ($elt == $subtree_root));
  5901.               }
  5902.             else
  5903.               { # case where the element has no child and no next sibling:
  5904.                 # get the first next sibling of an ancestor, checking subtree_root 
  5905.                 
  5906.                 # case where elt is subtree_root, is empty and has no sibling
  5907.                 last if( $subtree_root && ($elt == $subtree_root));
  5908.                
  5909.                 # backtrack until we find a parent with a next sibling
  5910.                 $next_elt= $elt->{parent} || last undef;
  5911.                 until( $next_elt->{next_sibling})
  5912.                   { last if( $subtree_root && ($subtree_root == $next_elt));
  5913.                     $next_elt= $next_elt->{parent} || last;
  5914.                   }
  5915.                 last if( $subtree_root && ($subtree_root == $next_elt)); 
  5916.                 $next_elt= $next_elt->{next_sibling};   
  5917.               }  
  5918.             $elt= $next_elt || last;
  5919.             push @descendants, $elt if( !$cond || ($elt->{gi} eq $ind));
  5920.           }
  5921.       }
  5922.     else
  5923.     # end optimization
  5924.       { # branch for a complex condition: use the regular (slow but simple) way
  5925.         while( $elt= $elt->next_elt( $subtree_root, $cond))
  5926.           { push @descendants, $elt; }
  5927.       }
  5928.     return @descendants;
  5929.   }
  5930.  
  5931.  
  5932. sub descendants_or_self
  5933.   { my( $elt, $cond)= @_;
  5934.     my @descendants= $elt->passes( $cond) ? ($elt) : (); 
  5935.     push @descendants, $elt->descendants( $cond);
  5936.     return @descendants;
  5937.   }
  5938.   
  5939. sub sibling
  5940.   { my $elt= shift;
  5941.     my $nb= shift;
  5942.     if( $nb > 0)
  5943.       { foreach( 1..$nb)
  5944.           { $elt= $elt->next_sibling( @_) or return undef; }
  5945.       }
  5946.     elsif( $nb < 0)
  5947.       { foreach( 1..(-$nb))
  5948.           { $elt= $elt->prev_sibling( @_) or return undef; }
  5949.       }
  5950.     else # $nb == 0
  5951.       { return $elt->passes( $_[0]); }
  5952.     return $elt;
  5953.   }
  5954.  
  5955. sub sibling_text
  5956.   { my $elt= sibling( @_);
  5957.     return $elt ? $elt->text : undef;
  5958.   }
  5959.  
  5960.  
  5961. sub child
  5962.   { my $elt= shift;
  5963.     my $nb= shift;
  5964.     if( $nb >= 0)
  5965.       { $elt= $elt->first_child( @_) or return undef;
  5966.         foreach( 1..$nb)
  5967.           { $elt= $elt->next_sibling( @_) or return undef; }
  5968.       }
  5969.     else
  5970.       { $elt= $elt->last_child( @_) or return undef;
  5971.         foreach( 2..(-$nb))
  5972.           { $elt= $elt->prev_sibling( @_) or return undef; }
  5973.       }
  5974.     return $elt;
  5975.   }
  5976.  
  5977. sub prev_siblings
  5978.   { my $elt= shift;
  5979.     my @siblings=();
  5980.     while( $elt= $elt->prev_sibling( @_))
  5981.       { unshift @siblings, $elt; }
  5982.     return @siblings;
  5983.   }
  5984.  
  5985. sub pos
  5986.   { my $elt= shift;
  5987.     return 0 if ($_[0] && !$elt->matches( @_));
  5988.     my $pos=1;
  5989.     $pos++ while( $elt= $elt->prev_sibling( @_));
  5990.     return $pos;
  5991.   }
  5992.  
  5993.  
  5994. sub next_siblings
  5995.   { my $elt= shift;
  5996.     my @siblings=();
  5997.     while( $elt= $elt->next_sibling( @_))
  5998.       { push @siblings, $elt; }
  5999.     return @siblings;
  6000.   }
  6001.  
  6002.  
  6003. # used by get_xpath: parses the xpath expression and generates a sub that performs the
  6004. # search
  6005. { my %axis2method;
  6006.   BEGIN { %axis2method= ( child               => 'children',
  6007.                           descendant          => 'descendants',
  6008.                          'descendant-or-self' => 'descendants_or_self',
  6009.                           parent              => 'parent_is',
  6010.                           ancestor            => 'ancestors',
  6011.                          'ancestor-or-self'   => 'ancestors_or_self',
  6012.                          'following-sibling'  => 'next_siblings',
  6013.                          'preceding-sibling'  => 'prev_siblings',
  6014.                           following           => 'following_elts',
  6015.                           preceding           => 'preceding_elts',
  6016.                           self                => '_self',
  6017.                         );
  6018.         }
  6019.  
  6020.   sub _install_xpath
  6021.     { my( $xpath_exp, $type)= @_;
  6022.       my $original_exp= $xpath_exp;
  6023.       my $sub= 'my $elt= shift; my @results;';
  6024.       
  6025.       # grab the root if expression starts with a /
  6026.       if( $xpath_exp=~ s{^/}{})
  6027.         { $sub .= '@results= ($elt->twig) || croak "cannot use an XPath query starting with a / on a node not attached to a whole twig";'; }
  6028.       elsif( $xpath_exp=~ s{^\./}{})
  6029.         { $sub .= '@results= ($elt);'; }
  6030.       else
  6031.         { $sub .= '@results= ($elt);'; }
  6032.   
  6033.  
  6034.      #warn "xpath_exp= '$xpath_exp'\n";
  6035.       while( $xpath_exp &&
  6036.              $xpath_exp=~s{^\s*(/?)                            
  6037.                             # the xxx=~/regexp/ is a pain as it includes /  
  6038.                             (\s*(?:(?:($REG_AXIS)::)?(\*|$REG_NAME|\.\.|\.)\s*)?($REG_PREDICATE_ALT*)
  6039.                             )
  6040.                             (/|$)}{}xo)
  6041.   
  6042.         { my( $wildcard, $sub_exp, $axis, $gi, $predicates)= ($1, $2, $3, $4, $5);
  6043.           #warn "wildcard= '$wildcard', sub_exp= '$sub_exp', axis= '$axis', gi= '$gi', predicates= '$predicates'\n";
  6044.           
  6045.           # grab a parent
  6046.           if( $sub_exp eq '..')
  6047.             { croak "error in xpath expression $original_exp" if( $wildcard);
  6048.               $sub .= '@results= map { $_->{parent}} @results;';
  6049.             }
  6050.           # test the element itself
  6051.           elsif( $sub_exp=~ m{^\.(.*)$}s)
  6052.             { $sub .= "\@results= grep { \$_->matches( q{$1}) } \@results;" }
  6053.               # grab children
  6054.           else       
  6055.             { 
  6056.               if( !$axis)             
  6057.                 { $axis= $wildcard ? 'descendant' : 'child'; }
  6058.               if( !$gi or $gi eq '*') { $gi=''; }
  6059.               my $function;
  6060.   
  6061.               # "special" predicates, that return just one element
  6062.               if( $predicates && ($predicates =~ m{^\s*\[\s*((-\s*)?\d+)\s*\]\s*$}))
  6063.                 { # [<nb>]
  6064.                   my $offset= $1;
  6065.                   $offset-- if( $offset > 0);
  6066.                   $function=  $axis eq 'descendant' ? "next_n_elt( $offset, '$gi')" 
  6067.                            :  $axis eq 'child'      ? "child( $offset, '$gi')"
  6068.                            :                          croak "error [$1] not supported along axis '$axis'"
  6069.                            ;
  6070.                   $sub .= "\@results= grep { \$_ } map { \$_->$function } \@results;"
  6071.                 }
  6072.               elsif( $predicates && ($predicates =~ m{^\s*\[\s*last\s*\(\s*\)\s*\]\s*$}) )
  6073.                 { # last()
  6074.                   croak "error in xpath expression $original_exp, usage of // and last() not supported" if( $wildcard);
  6075.                    $sub .= "\@results= map { \$_->last_child( '$gi') } \@results;";
  6076.                 }
  6077.               else
  6078.                 { # follow the axis
  6079.                   #warn "axis: '$axis' - method: '$axis2method{$axis}' - gi: '$gi'\n";
  6080.  
  6081.                   my $follow_axis= " \$_->$axis2method{$axis}( '$gi')";
  6082.                   my $step= $follow_axis;
  6083.                   
  6084.                   # now filter using the predicate
  6085.                   while( $predicates=~ s{^\s*($REG_PREDICATE_ALT)\s*}{}o)
  6086.                     { my $pred= $1;
  6087.                       $pred=~ s{^\s*\[\s*}{};
  6088.                       $pred=~ s{\s*\]\s*$}{};
  6089.                       my $test="";
  6090.                       my $pos;
  6091.                       if( $pred=~ m{^(-?\s*\d+)$})
  6092.                         { my $pos= $1;
  6093.                           if( $step=~ m{^\s*grep(.*) (\$_->\w+\(\s*'[^']*'\s*\))})
  6094.                             { $step= "XML::Twig::_first_n $1 $pos, $2"; }
  6095.                           else
  6096.                             { if( $pos > 0) { $pos--; }
  6097.                               $step= "($step)[$pos]"; 
  6098.                             }
  6099.                           #warn "number predicate '$pos' - generated step '$step'\n";
  6100.                         }
  6101.                       else
  6102.                         { my $syntax_error=0;
  6103.                           do
  6104.                             { if( $pred =~ s{^string\(\s*\)\s*=\s*($REG_STRING)\s*}{}o)  # string()="string" pred
  6105.                                 { $test .= "\$_->text eq $1"; }
  6106.                              elsif( $pred =~ s{^string\(\s*\)\s*($REG_MATCH)\s*($REG_REGEXP)\s*}{}o)  # string()=~/regex/ pred
  6107.                                 { my( $match, $regexp)= ($1, $2);
  6108.                                   $test .= "\$_->text $match $regexp"; 
  6109.                                 }
  6110.                              elsif( $pred=~ s{^@($REG_NAME)\s*($REG_OP)\s*($REG_STRING|$REG_NUMBER)}{}o)  # @att="val" pred
  6111.                                 { my( $att, $oper, $val)= ($1, _op( $2), $3);
  6112.                                   $test .= qq{((defined \$_->{'att'}->{"$att"})  && (\$_->{'att'}->{"$att"} $oper $val))};
  6113.                                 }
  6114.                              elsif( $pred =~ s{^@($REG_NAME)\s*($REG_MATCH)\s*($REG_REGEXP)\s*}{}o)  # @att=~/regex/ pred XXX
  6115.                                 { my( $att, $match, $regexp)= ($1, $2, $3);
  6116.                                   $test .= qq{((defined \$_->{'att'}->{"$att"})  && (\$_->{'att'}->{"$att"} $match $regexp))};; 
  6117.                                 }
  6118.                              elsif( $pred=~ s{^@($REG_NAME)\s*}{}o)                      # @att pred
  6119.                                 { $test .= qq{(defined \$_->{'att'}->{"$1"})}; }
  6120.                              elsif( $pred=~ s{^\s*(?:not|!)\s*@($REG_NAME)\s*}{}o)       # not @att pred
  6121.                                 { $test .= qq{((\$_->is_elt) && (not defined \$_->{'att'}->{"$1"}))}; }
  6122.                               elsif( $pred=~ s{^\s*([()])}{})                            # ( or ) (just add to the test)
  6123.                                 { $test .= qq{$1};           }
  6124.                               elsif( $pred=~ s{^\s*(and|or)\s*}{})
  6125.                                 { $test .= lc " $1 "; }
  6126.                               else
  6127.                                 { $syntax_error=1; }
  6128.                              
  6129.                              } while( !$syntax_error && $pred);
  6130.                            croak "error in xpath expression $original_exp at $pred" if( $pred);
  6131.                            $step= " grep { $test } $step ";
  6132.                         }
  6133.                     }
  6134.                   #warn "step: '$step'";
  6135.                   $sub .= "\@results= grep { \$_ } map { $step } \@results;"; 
  6136.                 }
  6137.             }
  6138.         }
  6139.   
  6140.       if( $xpath_exp)
  6141.         { 
  6142.           croak "error in xpath expression $original_exp around $xpath_exp ";
  6143.         }
  6144.         
  6145.       $sub .= q{return XML::Twig::_unique_elts( @results); };
  6146.       #warn "generated: '$sub'\n";
  6147.       my $s= eval "sub { $sub }";
  6148.       if( $@) { croak "error in xpath expression $original_exp ($@);" }
  6149.       return( $s); 
  6150.     }
  6151. }
  6152.  
  6153.  
  6154.           
  6155. { # extremely elaborate caching mechanism
  6156.   my %xpath; # xpath_expression => subroutine_code;  
  6157.   sub get_xpath
  6158.     { my( $elt, $xpath_exp, $offset)= @_;
  6159.       my $sub= ($xpath{$xpath_exp} ||= _install_xpath( $xpath_exp));
  6160.       return $sub->( $elt) unless( defined $offset); 
  6161.       my @res= $sub->( $elt);
  6162.       return $res[$offset];
  6163.     }
  6164. }
  6165.  
  6166.  
  6167. sub findvalue
  6168.   { my $elt= shift;
  6169.     return join '', map { $_->text } $elt->get_xpath( @_);
  6170.   }
  6171.  
  6172. #end-extract twig_node
  6173.  
  6174.  
  6175. # XML::XPath compatibility
  6176. sub getElementById     { return $_[0]->twig->elt_id( $_[1]); }
  6177. sub getChildNodes      { my @children= $_[0]->_children; return wantarray ? @children : \@children; }
  6178.  
  6179. sub _flushed     { return $_[0]->{flushed}; }
  6180. sub _set_flushed { $_[0]->{flushed}=1;      }
  6181. sub _del_flushed { delete $_[0]->{flushed}; }
  6182.  
  6183. sub cut
  6184.   { my $elt= shift;
  6185.     my( $parent, $prev_sibling, $next_sibling, $last_elt);
  6186.  
  6187.     # you can't cut the root, sorry
  6188.     unless( $parent= $elt->{parent}) { return; }
  6189.  
  6190.     # save the old links, that'll make it easier for some loops
  6191.     foreach my $link ( qw(parent prev_sibling next_sibling) )
  6192.       { $elt->{former}->{$link}= $elt->{$link};
  6193.         weaken( $elt->{former}->{$link}) if( $XML::Twig::weakrefs);
  6194.       }
  6195.  
  6196.     # it we cut the current element then its parent becomes the current elt
  6197.     if( $elt->{twig_current})
  6198.       { my $twig_current= $elt->{parent};
  6199.         my $t= $elt->twig;
  6200.         $t->{twig_current}= $twig_current;
  6201.         $twig_current->{'twig_current'}=1;
  6202.         delete $elt->{'twig_current'};
  6203.       }
  6204.  
  6205.     if( $parent->{first_child} == $elt)
  6206.       { $parent->{first_child}=  $elt->{next_sibling};
  6207.         $parent->{empty}= 1 unless( $elt->{next_sibling});
  6208.       }
  6209.     $parent->set_last_child( $elt->{prev_sibling}) 
  6210.       if( $parent->{last_child} == $elt);
  6211.  
  6212.     if( $prev_sibling= $elt->{prev_sibling})
  6213.       { $prev_sibling->{next_sibling}=  $elt->{next_sibling}; }
  6214.     if( $next_sibling= $elt->{next_sibling})
  6215.       { $next_sibling->set_prev_sibling( $elt->{prev_sibling}); }
  6216.  
  6217.  
  6218.     $elt->set_parent( undef);
  6219.     $elt->set_prev_sibling( undef);
  6220.     $elt->{next_sibling}=  undef;
  6221.  
  6222.     if( $prev_sibling && $next_sibling && $prev_sibling->is_text && ( $XML::Twig::index2gi[$prev_sibling->{'gi'}] eq $XML::Twig::index2gi[$next_sibling->{'gi'}]))
  6223.       { $prev_sibling->merge_text( $next_sibling); }
  6224.  
  6225.     return $elt;
  6226.   }
  6227.  
  6228.  
  6229. sub former_next_sibling { return $_[0]->{former}->{next_sibling}; }
  6230. sub former_prev_sibling { return $_[0]->{former}->{prev_sibling}; }
  6231. sub former_parent       { return $_[0]->{former}->{parent};       }
  6232.  
  6233. sub cut_children
  6234.   { my( $elt, $exp)= @_;
  6235.     my @children= $elt->children( $exp);
  6236.     foreach (@children) { $_->cut; }
  6237.     return @children;
  6238.   }
  6239.  
  6240.  
  6241. sub erase
  6242.   { my $elt= shift;
  6243.     #you cannot erase the current element
  6244.     if( $elt->{twig_current})
  6245.       { croak "trying to erase an element before it has been completely parsed"; }
  6246.     unless( $elt->{parent})
  6247.       { # trying to erase the root (of a twig or of a cut/new element)
  6248.         my @children= $elt->_children;
  6249.         unless( @children == 1)
  6250.           { croak "can only erase an element with no parent if it has a single child"; }
  6251.         $elt->_move_extra_data_after_erase;
  6252.         my $child= shift @children;
  6253.         $child->set_parent( undef);
  6254.         my $twig= $elt->twig;
  6255.         $twig->set_root( $child);
  6256.       }
  6257.     else     
  6258.       { # normal case
  6259.         $elt->_move_extra_data_after_erase;
  6260.         my @children= $elt->_children;
  6261.         if( @children)
  6262.           { # elt has children, move them up
  6263.  
  6264.             my $first_child= $elt->{first_child};
  6265.             my $prev_sibling=$elt->{prev_sibling};
  6266.             if( $prev_sibling)
  6267.               { # connect first child to previous sibling
  6268.                 $first_child->set_prev_sibling( $prev_sibling);      
  6269.                 $prev_sibling->{next_sibling}=  $first_child; 
  6270.               }
  6271.             else
  6272.               { # elt was the first child
  6273.                 $elt->{parent}->set_first_child( $first_child);
  6274.               }
  6275.  
  6276.             my $last_child= $elt->{last_child};
  6277.             my $next_sibling= $elt->{next_sibling};
  6278.             if( $next_sibling)
  6279.               { # connect last child to next sibling
  6280.                 $last_child->{next_sibling}=  $next_sibling;      
  6281.                 $next_sibling->set_prev_sibling( $last_child); 
  6282.               }
  6283.             else
  6284.               { # elt was the last child
  6285.                 $elt->{parent}->set_last_child( $last_child);
  6286.               }
  6287.             # update parent for all siblings
  6288.             foreach my $child (@children)
  6289.               { $child->set_parent( $elt->{parent}); }
  6290.  
  6291.             # merge consecutive text elements if need be
  6292.             if( $prev_sibling && $prev_sibling->is_text && ($XML::Twig::index2gi[$first_child->{'gi'}] eq $XML::Twig::index2gi[$prev_sibling->{'gi'}]) )
  6293.               { $prev_sibling->merge_text( $first_child); }
  6294.             if( $next_sibling && $next_sibling->is_text && ($XML::Twig::index2gi[$last_child->{'gi'}] eq $XML::Twig::index2gi[$next_sibling->{'gi'}]) )
  6295.               { $last_child->merge_text( $next_sibling); }
  6296.  
  6297.             # if parsing and have now a PCDATA text, mark so we can normalize later on of need be
  6298.             if( $elt->{parent}->{twig_current} && $elt->{last_child}->is_text) {  $elt->{parent}->{twig_to_be_normalized}=1; }
  6299.  
  6300.             # elt is not referenced any more, so it will be DESTROYed
  6301.             # so we'd better break the links to its children
  6302.             undef $elt->{first_child};
  6303.             undef $elt->{last_child};
  6304.             undef $elt->{parent};
  6305.             undef $elt->{prev_sibling};
  6306.             undef $elt->{next_sibling};
  6307.  
  6308.           }
  6309.           { # elt had no child, delete it
  6310.              $elt->delete;
  6311.           }
  6312.               
  6313.       }
  6314.     return $elt;
  6315.  
  6316.   }
  6317.  
  6318. sub _move_extra_data_after_erase
  6319.   { my( $elt)= @_;
  6320.     # extra_data
  6321.     if( my $extra_data= $elt->{extra_data}) 
  6322.       { my $target= $elt->{first_child} || $elt->{next_sibling};
  6323.         if( $target)
  6324.           {
  6325.             if( $target->is( '#ELT'))
  6326.               { $target->set_extra_data( $extra_data . ($target->extra_data || '')); }
  6327.             elsif( $target->is( '#TEXT'))
  6328.               { $target->_unshift_extra_data_in_pcdata( $extra_data, 0); }  # TO CHECK
  6329.           }
  6330.         else
  6331.           { my $parent= $elt->{parent}; # always exists or the erase cannot be performed
  6332.             $parent->_prefix_extra_data_before_end_tag( $extra_data); 
  6333.           }
  6334.       }
  6335.       
  6336.      # extra_data_before_end_tag
  6337.     if( my $extra_data= $elt->_extra_data_before_end_tag) 
  6338.       { if( my $target= $elt->{next_sibling})
  6339.           { if( $target->is( '#ELT'))
  6340.               { $target->set_extra_data( $extra_data . ($target->extra_data || '')); }
  6341.             elsif( $target->is( '#TEXT'))
  6342.               { 
  6343.                 $target->_unshift_extra_data_in_pcdata( $extra_data, 0);
  6344.              }
  6345.           }
  6346.         elsif( my $parent= $elt->{parent})
  6347.           { $parent->_prefix_extra_data_before_end_tag( $extra_data); }
  6348.        }
  6349.  
  6350.     return $elt;
  6351.  
  6352.   }
  6353. BEGIN
  6354.   { my %method= ( before      => \&paste_before,
  6355.                   after       => \&paste_after,
  6356.                   first_child => \&paste_first_child,
  6357.                   last_child  => \&paste_last_child,
  6358.                   within      => \&paste_within,
  6359.         );
  6360.     
  6361.     # paste elt somewhere around ref
  6362.     # pos can be first_child (default), last_child, before, after or within
  6363.     sub paste
  6364.       { my $elt= shift;
  6365.         if( $elt->{parent}) 
  6366.           { croak "cannot paste an element that belongs to a tree"; }
  6367.         my $pos;
  6368.         my $ref;
  6369.         if( ref $_[0]) 
  6370.           { $pos= 'first_child'; 
  6371.             croak "wrong argument order in paste, should be $_[1] first" if($_[1]); 
  6372.           }
  6373.         else
  6374.           { $pos= shift; }
  6375.  
  6376.         if( my $method= $method{$pos})
  6377.           {
  6378.             unless( isa( $_[0], "XML::Twig::Elt"))
  6379.               { if( ! defined( $_[0]))
  6380.                   { croak "missing target in paste"; }
  6381.                 elsif( ! ref( $_[0]))
  6382.                   { croak "wrong target type in paste (not a reference), should be XML::Twig::Elt or a subclass"; }
  6383.                 else
  6384.                   { my $ref= ref $_[0];
  6385.                     croak "wrong target type in paste: '$ref', should be XML::Twig::Elt or a subclass";
  6386.                   }
  6387.               }
  6388.             $ref= $_[0];
  6389.             # check here so error message lists the caller file/line
  6390.             if( !$ref->{parent} && ($pos=~ m{^(before|after)$}) && !(exists $elt->{'target'}) && !(exists $elt->{'comment'})) 
  6391.               { croak "cannot paste $1 root"; }
  6392.             $elt->$method( @_); 
  6393.           }
  6394.         else
  6395.           { croak "tried to paste in wrong position '$pos', allowed positions " . 
  6396.               " are 'first_child', 'last_child', 'before', 'after' and "    .
  6397.               "'within'";
  6398.           }
  6399.         if( (my $ids= $elt->{twig_id_list}) && (my $t= $ref->twig) )
  6400.           { $t->{twig_id_list}||={};
  6401.             @{$t->{twig_id_list}}{keys %$ids}= values %$ids;
  6402.           }
  6403.         return $elt;
  6404.       }
  6405.   
  6406.  
  6407.     sub paste_before
  6408.       { my( $elt, $ref)= @_;
  6409.         my( $parent, $prev_sibling, $next_sibling );
  6410.         
  6411.         # trying to paste before an orphan (root or detached wlt)
  6412.         unless( $ref->{parent}) 
  6413.           { if( my $t= $ref->twig)
  6414.               { if( (exists $elt->{'comment'}) || (exists $elt->{'target'})) # we can still do this
  6415.                   { $t->_add_cpi_outside_of_root( leading_cpi => $elt); return; }
  6416.                 else
  6417.                   { croak "cannot paste before root"; }
  6418.               }
  6419.             else
  6420.               { croak "cannot paste before an orphan element"; }
  6421.           }
  6422.         $parent= $ref->{parent};
  6423.         $prev_sibling= $ref->{prev_sibling};
  6424.         $next_sibling= $ref;
  6425.  
  6426.         $elt->set_parent( $parent);
  6427.         $parent->{first_child}=  $elt if( $parent->{first_child} == $ref);
  6428.  
  6429.         $prev_sibling->{next_sibling}=  $elt if( $prev_sibling);
  6430.         $elt->set_prev_sibling( $prev_sibling);
  6431.  
  6432.         $next_sibling->set_prev_sibling( $elt);
  6433.         $elt->{next_sibling}=  $ref;
  6434.         return $elt;
  6435.       }
  6436.      
  6437.      sub paste_after
  6438.       { my( $elt, $ref)= @_;
  6439.         my( $parent, $prev_sibling, $next_sibling );
  6440.  
  6441.         # trying to paste after an orphan (root or detached wlt)
  6442.         unless( $ref->{parent}) 
  6443.             { if( my $t= $ref->twig)
  6444.                 { if( (exists $elt->{'comment'}) || (exists $elt->{'target'})) # we can still do this
  6445.                     { $t->_add_cpi_outside_of_root( trailing_cpi => $elt); return; }
  6446.                   else
  6447.                     { croak "cannot paste after root"; }
  6448.                 }
  6449.               else
  6450.                 { croak "cannot paste after an orphan element"; }
  6451.             }
  6452.         $parent= $ref->{parent};
  6453.         $prev_sibling= $ref;
  6454.         $next_sibling= $ref->{next_sibling};
  6455.  
  6456.         $elt->set_parent( $parent);
  6457.         $parent->set_last_child( $elt) if( $parent->{last_child}== $ref);
  6458.  
  6459.         $prev_sibling->{next_sibling}=  $elt;
  6460.         $elt->set_prev_sibling( $prev_sibling);
  6461.  
  6462.         $next_sibling->set_prev_sibling( $elt) if( $next_sibling);
  6463.         $elt->{next_sibling}=  $next_sibling;
  6464.         return $elt;
  6465.  
  6466.       }
  6467.  
  6468.     sub paste_first_child
  6469.       { my( $elt, $ref)= @_;
  6470.         my( $parent, $prev_sibling, $next_sibling );
  6471.         $parent= $ref;
  6472.         $next_sibling= $ref->{first_child};
  6473.         delete $ref->{empty};
  6474.  
  6475.         $elt->set_parent( $parent);
  6476.         $parent->{first_child}=  $elt;
  6477.         $parent->set_last_child( $elt) unless( $parent->{last_child});
  6478.  
  6479.         $elt->set_prev_sibling( undef);
  6480.  
  6481.         $next_sibling->set_prev_sibling( $elt) if( $next_sibling);
  6482.         $elt->{next_sibling}=  $next_sibling;
  6483.         return $elt;
  6484.       }
  6485.       
  6486.     sub paste_last_child
  6487.       { my( $elt, $ref)= @_;
  6488.         my( $parent, $prev_sibling, $next_sibling );
  6489.         $parent= $ref;
  6490.         $prev_sibling= $ref->{last_child};
  6491.         delete $ref->{empty};
  6492.  
  6493.         $elt->set_parent( $parent);
  6494.         $parent->set_last_child( $elt);
  6495.         $parent->{first_child}=  $elt unless( $parent->{first_child});
  6496.  
  6497.         $elt->set_prev_sibling( $prev_sibling);
  6498.         $prev_sibling->{next_sibling}=  $elt if( $prev_sibling);
  6499.  
  6500.         $elt->{next_sibling}=  undef;
  6501.         return $elt;
  6502.       }
  6503.  
  6504.     sub paste_within
  6505.       { my( $elt, $ref, $offset)= @_;
  6506.         my $text= $ref->is_text ? $ref : $ref->next_elt( '#TEXT', $ref);
  6507.         my $new= $text->split_at( $offset);
  6508.         $elt->paste_before( $new);
  6509.         return $elt;
  6510.       }
  6511.   }
  6512.  
  6513. # load an element into a structure similar to XML::Simple's
  6514. sub simplify
  6515.   { my $elt= shift;
  6516.  
  6517.     # normalize option names
  6518.     my %options= @_;
  6519.     %options= map { my ($key, $val)= ($_, $options{$_});
  6520.                        $key=~ s{(\w)([A-Z])}{$1_\L$2}g;
  6521.                        $key => $val
  6522.                      } keys %options;
  6523.  
  6524.     # check options
  6525.     my @allowed_options= qw( keyattr forcearray noattr content_key
  6526.                              var var_regexp variables var_attr 
  6527.                              group_tags forcecontent
  6528.                              normalise_space normalize_space
  6529.                    );
  6530.     my %allowed_options= map { $_ => 1 } @allowed_options;
  6531.     foreach my $option (keys %options)
  6532.       { warn "invalid option $option\n" unless( $allowed_options{$option}); }
  6533.  
  6534.     $options{normalise_space} ||= $options{normalize_space} || 0;
  6535.     
  6536.     $options{content_key} ||= 'content';
  6537.     if( $options{content_key}=~ m{^-})
  6538.       { # need to remove the - and to activate extra folding
  6539.         $options{content_key}=~ s{^-}{};
  6540.         $options{extra_folding}= 1;
  6541.       }
  6542.     else
  6543.       { $options{extra_folding}= 0; }
  6544.    
  6545.     $options{forcearray} ||=0; 
  6546.     if( isa( $options{forcearray}, 'ARRAY'))
  6547.       { my %forcearray_tags= map { $_ => 1 } @{$options{forcearray}};
  6548.         $options{forcearray_tags}= \%forcearray_tags;
  6549.         $options{forcearray}= 0;
  6550.       }
  6551.  
  6552.     $options{keyattr}     ||= ['name', 'key', 'id'];
  6553.     if( ref $options{keyattr} eq 'ARRAY')
  6554.       { foreach my $keyattr (@{$options{keyattr}})
  6555.           { my( $prefix, $att)= ($keyattr=~ m{^([+-])?(.*)});
  6556.             $prefix ||= '';
  6557.             $options{key_for_all}->{$att}= 1;
  6558.             $options{remove_key_for_all}->{$att}=1 unless( $prefix eq '+');
  6559.             $options{prefix_key_for_all}->{$att}=1 if( $prefix eq '-');
  6560.           }
  6561.       }
  6562.     elsif( ref $options{keyattr} eq 'HASH')
  6563.       { while( my( $elt, $keyattr)= each %{$options{keyattr}})
  6564.          { my( $prefix, $att)= ($keyattr=~ m{^([+-])?(.*)});
  6565.            $prefix ||='';
  6566.            $options{key_for_elt}->{$elt}= $att;
  6567.            $options{remove_key_for_elt}->{"$elt#$att"}=1 unless( $prefix);
  6568.            $options{prefix_key_for_elt}->{"$elt#$att"}=1 if( $prefix eq '-');
  6569.          }
  6570.       }
  6571.        
  6572.  
  6573.     $options{var}||= $options{var_attr}; # for compat with XML::Simple
  6574.     if( $options{var}) { $options{var_values}= {}; }
  6575.     else               { $options{var}='';         }
  6576.  
  6577.     if( $options{variables}) 
  6578.       { $options{var}||= 1;
  6579.         $options{var_values}= $options{variables};
  6580.       }
  6581.  
  6582.     if( $options{var_regexp} and !$options{var})
  6583.       { warn "var option not used, var_regexp option ignored\n"; }
  6584.     $options{var_regexp} ||= '\$\{?(\w+)\}?';
  6585.       
  6586.     $elt->_simplify( \%options);
  6587.  
  6588.  }
  6589.  
  6590. sub _simplify
  6591.   { my( $elt, $options)= @_;
  6592.  
  6593.     my $data;
  6594.  
  6595.     my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
  6596.     my @children= $elt->_children;
  6597.     my %atts= $options->{noattr} || !$elt->atts ? () : %{$elt->atts};
  6598.     my $nb_atts= keys %atts;
  6599.     my $nb_children= $elt->children_count + $nb_atts;
  6600.  
  6601.     my %nb_children;
  6602.     foreach (@children)   { $nb_children{$_->tag}++; }
  6603.     foreach (keys %atts)  { $nb_children{$_}++;      }
  6604.  
  6605.     my $arrays; # tag => array where elements are stored
  6606.  
  6607.  
  6608.     # store children
  6609.     foreach my $child (@children)
  6610.       { if( $child->is_text)
  6611.           { # generate with a content key
  6612.             my $text= $elt->_text_with_vars( $options);
  6613.             $text= _normalize_space( $text) if( $options->{normalise_space} >= 2);
  6614.             if(    $options->{force_content}
  6615.                 || $nb_atts 
  6616.                 || (scalar @children > 1)
  6617.               )
  6618.               { $data->{$options->{content_key}}= $text; }
  6619.             else
  6620.               { $data= $text; }
  6621.           }
  6622.         else
  6623.           { # element with sub elements
  6624.             my $child_gi= $XML::Twig::index2gi[$child->{'gi'}];
  6625.  
  6626.             my $child_data= $child->_simplify( $options);
  6627.  
  6628.             # first see if we need to simplify further the child data
  6629.             # simplify because of grouped tags
  6630.             if( my $grouped_tag= $options->{group_tags}->{$child_gi})
  6631.               { # check that the child data is a hash with a single field
  6632.                 unless(    (ref( $child_data) eq 'HASH')
  6633.                         && (keys %$child_data == 1)
  6634.                         && defined ( my $grouped_child_data= $child_data->{$grouped_tag})
  6635.                       )
  6636.                   { croak "error in grouped tag $child_gi"; }
  6637.                 else
  6638.                   { $child_data=  $grouped_child_data; }
  6639.               }
  6640.             # simplify because of extra folding
  6641.             if( $options->{extra_folding})
  6642.               { if(    (ref( $child_data) eq 'HASH')
  6643.                     && (keys %$child_data == 1)
  6644.                     && defined( my $content= $child_data->{$options->{content_key}})
  6645.                   )
  6646.                   { $child_data= $content; }
  6647.               }
  6648.  
  6649.             if( my $keyatt= $child->_key_attr( $options))
  6650.               { # simplify element with key
  6651.                 my $key= $child->{'att'}->{$keyatt};
  6652.                 $key= _normalize_space( $key) if( $options->{normalise_space} >= 1);
  6653.                 $data->{$child_gi}->{$key}= $child_data;
  6654.               }
  6655.             elsif(      $options->{forcearray}
  6656.                    ||   $options->{forcearray_tags}->{$child_gi}
  6657.                    || ( $nb_children{$child_gi} > 1)
  6658.                  )
  6659.               { # simplify element to store in an array
  6660.                 $data->{$child_gi} ||= [];
  6661.                 push @{$data->{$child_gi}}, $child_data;
  6662.               }
  6663.             else
  6664.               { # simplify element to store as a hash field
  6665.                 $data->{$child_gi}= $child_data;
  6666.               }
  6667.           }
  6668.     }
  6669.  
  6670.     # store atts
  6671.     # TODO: deal with att that already have an element by that name
  6672.     foreach my $att (keys %atts)
  6673.       { # do not store if the att is a key that needs to be removed
  6674.         if(    $options->{remove_key_for_all}->{$att}
  6675.             || $options->{remove_key_for_elt}->{"$gi#$att"}
  6676.           )
  6677.           { next; }
  6678.  
  6679.         my $att_text= $options->{var} ?  _replace_vars_in_text( $atts{$att}, $options) : $atts{$att} ;
  6680.         $att_text= _normalize_space( $att_text) if( $options->{normalise_space} >= 2);
  6681.         
  6682.         if(    $options->{prefix_key_for_all}->{$att}
  6683.             || $options->{prefix_key_for_elt}->{"$gi#$att"}
  6684.           )
  6685.           { # prefix the att
  6686.             $data->{"-$att"}= $att_text;
  6687.           } 
  6688.         else
  6689.           { # normal case
  6690.             $data->{$att}= $att_text; 
  6691.           }
  6692.       }
  6693.     
  6694.     return $data;
  6695.   }
  6696.  
  6697. sub _key_attr
  6698.   { my( $elt, $options)=@_;
  6699.     return if( $options->{noattr});
  6700.     if( $options->{key_for_all})
  6701.       { foreach my $att ($elt->att_names)
  6702.           { if( $options->{key_for_all}->{$att})
  6703.               { return $att; }
  6704.           }
  6705.       }
  6706.     elsif( $options->{key_for_elt})
  6707.       { if( my $key_for_elt= $options->{key_for_elt}->{$XML::Twig::index2gi[$elt->{'gi'}]} )
  6708.           { return $key_for_elt if( defined( $elt->{'att'}->{$key_for_elt})); }
  6709.       }
  6710.     return;
  6711.   }
  6712.  
  6713. sub _text_with_vars
  6714.   { my( $elt, $options)= @_;
  6715.     my $text;
  6716.     if( $options->{var}) 
  6717.       { $text= _replace_vars_in_text( $elt->text, $options); 
  6718.         $elt->_store_var( $options);
  6719.       }
  6720.      else
  6721.       { $text= $elt->text; }
  6722.     return $text;
  6723.   }
  6724.  
  6725.  
  6726. sub _normalize_space
  6727.   { my $text= shift;
  6728.     $text=~ s{\s+}{ }sg;
  6729.     $text=~ s{^\s}{};
  6730.     $text=~ s{\s$}{};
  6731.     return $text;
  6732.   }
  6733.  
  6734.  
  6735. sub att_nb
  6736.   { return 0 unless( my $atts= $_[0]->atts);
  6737.     return scalar keys %$atts;
  6738.   }
  6739.     
  6740. sub has_no_atts
  6741.   { return 1 unless( my $atts= $_[0]->atts);
  6742.     return scalar keys %$atts ? 0 : 1;
  6743.  }
  6744.     
  6745. sub _replace_vars_in_text
  6746.   { my( $text, $options)= @_;
  6747.  
  6748.     $text=~ s{($options->{var_regexp})}
  6749.              { if( defined( my $value= $options->{var_values}->{$2}))
  6750.                  { $value }
  6751.                else
  6752.                  { warn "unknown variable $2\n";
  6753.                    $1
  6754.                  }
  6755.              }gex;
  6756.     return $text;
  6757.   }
  6758.  
  6759. sub _store_var
  6760.   { my( $elt, $options)= @_;
  6761.     if( defined (my $var_name= $elt->{'att'}->{$options->{var}}))
  6762.        { $options->{var_values}->{$var_name}= $elt->text; 
  6763.        }
  6764.   }
  6765.  
  6766.  
  6767. # split a text element at a given offset
  6768. sub split_at
  6769.   { my( $elt, $offset)= @_;
  6770.     my $text_elt= $elt->is_text ? $elt : $elt->first_child( TEXT) || return '';
  6771.     my $string= $text_elt->text; 
  6772.     my $left_string= substr( $string, 0, $offset);
  6773.     my $right_string= substr( $string, $offset);
  6774.     $text_elt->set_pcdata( $left_string);
  6775.     my $new_elt= $elt->new( $XML::Twig::index2gi[$elt->{'gi'}], $right_string);
  6776.     $new_elt->paste( after => $elt);
  6777.     return $new_elt;
  6778.   }
  6779.  
  6780.     
  6781. # split an element or its text descendants into several, in place
  6782. # all elements (new and untouched) are returned
  6783. sub split    
  6784.   { my $elt= shift;
  6785.     my @text_chunks;
  6786.     my @result;
  6787.     if( $elt->is_text) { @text_chunks= ($elt); }
  6788.     else               { @text_chunks= $elt->descendants( '#TEXT'); }
  6789.     foreach my $text_chunk (@text_chunks)
  6790.       { push @result, $text_chunk->_split( 1, @_); }
  6791.     return @result;
  6792.   }
  6793.  
  6794. # split an element or its text descendants into several, in place
  6795. # created elements (those which match the regexp) are returned
  6796. sub mark
  6797.   { my $elt= shift;
  6798.     my @text_chunks;
  6799.     my @result;
  6800.     if( $elt->is_text) { @text_chunks= ($elt); }
  6801.     else               { @text_chunks= $elt->descendants( '#TEXT'); }
  6802.     foreach my $text_chunk (@text_chunks)
  6803.       { push @result, $text_chunk->_split( 0, @_); }
  6804.     return @result;
  6805.   }
  6806.  
  6807. # split a single text element
  6808. # return_all defines what is returned: if it is true 
  6809. # only returns the elements created by matches in the split regexp
  6810. # otherwise all elements (new and untouched) are returned
  6811.  
  6812. { my $encode_is_loaded=0;   # so we only load Encode once in 5.8.0+
  6813.  
  6814.   sub _split
  6815.     { my $elt= shift;
  6816.       my $return_all= shift;
  6817.       my $regexp= shift;
  6818.       my @tags;
  6819.  
  6820.       while( my $tag= shift())
  6821.         { if( ref $_[0]) 
  6822.             { push @tags, { tag => $tag, atts => shift }; }
  6823.           else
  6824.             { push @tags, { tag => $tag }; }
  6825.         }
  6826.  
  6827.       unless( @tags) { @tags= { tag => $elt->parent( '#ELT')->gi }; }
  6828.           
  6829.       my @result;                                 # the returned list of elements
  6830.       my $text= $elt->text;
  6831.       my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
  6832.   
  6833.       # 2 uses: if split matches then the first substring reuses $elt
  6834.       #         once a split has occured then the last match needs to be put in
  6835.       #         a new element      
  6836.       my $previous_match= 0;
  6837.  
  6838.       while( my( $pre_match, @matches)= $text=~ /^(.*?)$regexp(.*)$/gcs)
  6839.         { $text= pop @matches;
  6840.           if( $previous_match)
  6841.             { # match, not the first one, create a new text ($gi) element
  6842.               $pre_match= _utf8_ify( $pre_match) if($] == 5.008 && !_keep_encoding());
  6843.               $elt= $elt->insert_new_elt( after => $gi, $pre_match);
  6844.               push @result, $elt if( $return_all);
  6845.             }
  6846.           else
  6847.             { # first match in $elt, re-use $elt for the first sub-string
  6848.               $elt->set_text( _utf8_ify( $pre_match));
  6849.               $previous_match++;                # store the fact that there was a match
  6850.               push @result, $elt if( $return_all);
  6851.             }
  6852.  
  6853.           # now deal with matches captured in the regexp
  6854.           if( @matches)
  6855.             { # match, with capture
  6856.               my $i=0;
  6857.               foreach my $match (@matches)
  6858.                 { # create new element, text is the match
  6859.                   $match= _utf8_ify( $match) if($] == 5.008 && !_keep_encoding());
  6860.                   my $tag  = $tags[$i]->{tag};
  6861.                   my $atts = \%{$tags[$i]->{atts}} || {};
  6862.                   $elt= $elt->insert_new_elt( after => $tag, $atts, $match);
  6863.                   push @result, $elt;
  6864.                   $i= ($i + 1) % @tags;
  6865.                 }
  6866.             }
  6867.           else
  6868.             { # match, no captures
  6869.               my $tag  = $tags[0]->{tag};
  6870.               my $atts = \%{$tags[0]->{atts}} || {};
  6871.               $elt=  $elt->insert_new_elt( after => $tag, $atts);
  6872.               push @result, $elt;
  6873.             }
  6874.         }
  6875.       if( $previous_match && $text)
  6876.         { # there was at least 1 match, and there is text left after the match
  6877.           $elt= $elt->insert_new_elt( after => $gi, $text);
  6878.         }
  6879.  
  6880.       push @result, $elt if( $return_all);
  6881.  
  6882.       return @result; # return all elements
  6883.    }
  6884.  
  6885.   # evil hack needed in 5.8.0, the utf flag is not set on $<n>...
  6886.   sub _utf8_ify
  6887.     { my $string= shift;
  6888.       if( $] == 5.008 and !_keep_encoding()) 
  6889.         { unless( $encode_is_loaded) { require Encode; import Encode; $encode_is_loaded++; }
  6890.           Encode::_utf8_on( $string); # the flag should be set but is not
  6891.         }
  6892.       return $string;
  6893.     }
  6894.  
  6895.  
  6896. }
  6897.  
  6898. { my %replace_sub; # cache for complex expressions (expression => sub)
  6899.  
  6900.   sub subs_text
  6901.     { my( $elt, $regexp, $replace)= @_;
  6902.   
  6903.       my $replacement_string;
  6904.       my $is_string= _is_string( $replace);
  6905.       foreach my $text_elt ($elt->descendants_or_self( '#TEXT'))
  6906.         { if( $is_string)
  6907.             { my $text= $text_elt->text;
  6908.               $text=~ s{$regexp}{ _replace_var( $replace, $1, $2, $3, $4, $5, $6, $7, $8, $9)}egx;
  6909.               $text_elt->set_text( $text);
  6910.            }
  6911.           else
  6912.             { 
  6913.               my $replace_sub= ( $replace_sub{$replace} ||= _install_replace_sub( $replace)); 
  6914.               my $text= $text_elt->text;
  6915.               my $pos=0;  # used to skip text that was previously matched
  6916.               while( my( $pre_match_string, $match_string, @var)= ($text=~ m{(.*?)($regexp)}sg))
  6917.                 { my $match_start  = length( $pre_match_string);
  6918.                   my $match        = $text_elt->split_at( $match_start + $pos);
  6919.                   my $match_length = length( $match_string);
  6920.                   my $post_match   = $match->split_at( $match_length);
  6921.                   $replace_sub->( $match, @var);
  6922.                   # merge previous text with current one
  6923.                   my $next_sibling;
  6924.                   if(    ($next_sibling= $text_elt->{next_sibling})
  6925.                       && ($XML::Twig::index2gi[$text_elt->{'gi'}] eq $XML::Twig::index2gi[$next_sibling->{'gi'}])
  6926.                     )
  6927.                     { $text_elt->merge_text( $next_sibling); }
  6928.                     
  6929.                   # if the match is at the beginning of the text an empty #PCDATA is left: remove it 
  6930.                   if( !$text_elt->text) { $text_elt->delete; } 
  6931.                   
  6932.                   # go to next 
  6933.                   $text_elt= $post_match;
  6934.                   $text= $post_match->text;
  6935.                   # merge last text element with next one if needed,
  6936.                   # the match will be against the non-matched text,
  6937.                   # so $pos is used to skip the merged part
  6938.                   my $prev_sibling;
  6939.                   if(    ($prev_sibling=  $post_match->{prev_sibling})
  6940.                       && ($XML::Twig::index2gi[$post_match->{'gi'}] eq $XML::Twig::index2gi[$prev_sibling->{'gi'}])
  6941.                     )
  6942.                     { $pos= length( $prev_sibling->text);
  6943.                       $prev_sibling->merge_text( $post_match); 
  6944.                     }
  6945.  
  6946.                   # if the match is at the end of the text an empty #PCDATA is left: remove it 
  6947.                   if( !$text_elt->text) { $text_elt->delete; } 
  6948.                   
  6949.                 }
  6950.               
  6951.             }
  6952.         }
  6953.       return $elt;
  6954.     }
  6955.  
  6956.  
  6957.   sub _is_string
  6958.     { return ($_[0]=~ m{&e[ln]t}) ? 0: 1 }
  6959.  
  6960.   sub _replace_var
  6961.     { my( $string, @var)= @_;
  6962.       unshift @var, undef;
  6963.       $string=~ s{\$(\d)}{$var[$1]}g;
  6964.       return $string;
  6965.     }
  6966.  
  6967.   sub _install_replace_sub
  6968.     { my $replace_exp= shift;
  6969.       my @item= split m{(&e[ln]t\s*\([^)]*\))}, $replace_exp;
  6970.       my $sub= q{ my( $match, @var)= @_; unshift @var, undef; my $new; };
  6971.       my( $gi, $exp);
  6972.       foreach my $item (@item)
  6973.         { if(    $item=~ m{^&elt\s*\(([^)]*)\)})
  6974.             { $exp= $1;
  6975.             }
  6976.           elsif( $item=~ m{^&ent\s*\(\s*([^\s)]*)\s*\)})
  6977.             { $exp= " '#ENT' => $1"; }
  6978.           else
  6979.             { $exp= qq{ '#PCDATA' => "$item"}; }
  6980.           $exp=~ s{\$(\d)}{\$var[$1]}g; # replace references to matches
  6981.           $sub.= qq{ \$new= \$match->new( $exp); };
  6982.           $sub .= q{ $new->paste( before => $match); };
  6983.         }
  6984.       $sub .= q{ $match->delete; };
  6985.       #$sub=~ s/;/;\n/g;
  6986.       my $coderef= eval "sub { $sub }";
  6987.       if( $@) { croak( "invalid replacement expression $replace_exp: ",$@); }
  6988.       return $coderef;
  6989.     }
  6990.  
  6991.   }
  6992.  
  6993.  
  6994. sub merge_text
  6995.   { my( $e1, $e2)= @_;
  6996.     croak "invalid merge: can only merge 2 elements" 
  6997.         unless( isa( $e2, 'XML::Twig::Elt'));
  6998.     croak "invalid merge: can only merge 2 text elements" 
  6999.         unless( $e1->is_text && $e2->is_text && ($e1->gi eq $e2->gi));
  7000.     my $text1= $e1->text;
  7001.     my $text2= $e2->text;
  7002.     $e1->set_text( $text1 . $text2);
  7003.  
  7004.     my $extra_data= $e1->_extra_data_before_end_tag . $e2->extra_data;
  7005.     if( $extra_data) 
  7006.       { $e1->_del_extra_data_before_end_tag;
  7007.         $e1->_push_extra_data_in_pcdata( $extra_data, length( $text1)); 
  7008.       }
  7009.  
  7010.     if( $extra_data= $e2->_extra_data_in_pcdata)
  7011.       { foreach my $data (@$extra_data) { $e1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + length( $text1)); } }
  7012.  
  7013.     if( my $extra_data_before_end_tag= $e2->_extra_data_before_end_tag) 
  7014.       { $e1->_set_extra_data_before_end_tag( $extra_data_before_end_tag); }
  7015.  
  7016.     $e2->delete;
  7017.  
  7018.     return $e1;
  7019.   }
  7020.  
  7021. sub merge
  7022.   { my( $e1, $e2)= @_;
  7023.     my @e2_children= $e2->_children;
  7024.     if(     $e1->_last_child && $e1->_last_child->is_pcdata
  7025.         &&  @e2_children && $e2_children[0]->is_pcdata
  7026.       )
  7027.       { $e1->_last_child->{pcdata} .= $e2_children[0]->{pcdata}; shift @e2_children; }
  7028.     foreach my $e (@e2_children) { $e->move( last_child => $e1); } 
  7029.     $e2->delete;
  7030.     return $e1;
  7031.   }
  7032.  
  7033.  
  7034. # recursively copy an element and returns the copy (can be huge and long)
  7035. sub copy
  7036.   { my $elt= shift;
  7037.     my $copy= $elt->new( $XML::Twig::index2gi[$elt->{'gi'}]);
  7038.  
  7039.     $copy->set_extra_data( $elt->extra_data) if( $elt->extra_data);
  7040.     $copy->_set_extra_data_before_end_tag( $elt->_extra_data_before_end_tag) if( $elt->_extra_data_before_end_tag);
  7041.  
  7042.     $copy->set_asis                          if( $elt->is_asis);
  7043.     if( ($elt->{'empty'} || 0)) { $copy->{empty}= 1; } # do not swap or speedup will mess up this                         
  7044.  
  7045.     if( (exists $elt->{'pcdata'}))
  7046.       { $copy->set_pcdata( $elt->{pcdata}); 
  7047.         $copy->_set_extra_data_in_pcdata( $elt->_extra_data_in_pcdata) if( $elt->_extra_data_in_pcdata);
  7048.       }
  7049.     elsif( (exists $elt->{'cdata'}))
  7050.       { $copy->_set_cdata( $elt->{cdata}); 
  7051.         $copy->_set_extra_data_in_pcdata( $elt->_extra_data_in_pcdata) if( $elt->_extra_data_in_pcdata);
  7052.       }
  7053.     elsif( (exists $elt->{'target'}))
  7054.       { $copy->_set_pi( $elt->{target}, $elt->{data}); }
  7055.     elsif( (exists $elt->{'comment'}))
  7056.       { $copy->_set_comment( $elt->{comment}); }
  7057.     elsif( (exists $elt->{'ent'}))
  7058.       { $copy->{ent}=  $elt->{ent}; }
  7059.     else
  7060.       { my @children= $elt->_children;
  7061.         if( my $atts= $elt->atts)
  7062.           { my %atts= %{$atts}; # we want to do a real copy of the attributes
  7063.             $copy->set_atts( \%atts);
  7064.           }
  7065.         foreach my $child (@children)
  7066.           { my $child_copy= $child->copy;
  7067.             $child_copy->paste( 'last_child', $copy);
  7068.           }
  7069.       }
  7070.     # save links to the original location, which can be convenient and is used for namespace resolution
  7071.     foreach my $link ( qw(parent prev_sibling next_sibling) )
  7072.       { $copy->{former}->{$link}= $elt->{$link};
  7073.         weaken( $copy->{former}->{$link}) if( $XML::Twig::weakrefs);
  7074.       }
  7075.  
  7076.     return $copy;
  7077.   }
  7078.  
  7079.  
  7080. sub delete
  7081.   { my $elt= shift;
  7082.     $elt->cut;
  7083.     $elt->DESTROY unless( $XML::Twig::weakrefs);
  7084.     return undef;
  7085.   }
  7086.  
  7087.   sub DESTROY
  7088.     { my $elt= shift;
  7089.       return if( $XML::Twig::weakrefs);
  7090.       my $t= shift || $elt->twig; # optional argument, passed in recursive calls
  7091.  
  7092.       foreach( @{[$elt->_children]}) { $_->DESTROY( $t); }
  7093.  
  7094.       # the id reference needs to be destroyed
  7095.       # lots of tests to avoid warnings during the cleanup phase
  7096.       $elt->del_id( $t) if( $ID && $t && defined( $elt->{att}) && exists( $elt->{att}->{$ID}));
  7097.       undef $elt;
  7098.     }
  7099. }
  7100.  
  7101.  
  7102. # ignores the element
  7103. sub ignore
  7104.   { my $elt= shift;
  7105.     my $t= $elt->twig;
  7106.     $t->ignore( $elt, @_);
  7107.   }
  7108.  
  7109. BEGIN {
  7110.   my $pretty                    = 0;
  7111.   my $quote                     = '"';
  7112.   my $INDENT                    = '  ';
  7113.   my $empty_tag_style           = 0;
  7114.   my $remove_cdata              = 0;
  7115.   my $keep_encoding             = 0;
  7116.   my $expand_external_entities  = 0;
  7117.   my $keep_atts_order           = 0;
  7118.   my $do_not_escape_amp_in_atts = 0;
  7119.   my $WRAP                      = '80';
  7120.  
  7121.   my ($NSGMLS, $NICE, $INDENTED, $INDENTEDC, $WRAPPED, $RECORD1, $RECORD2, $INDENTEDA)= (1..8);
  7122.  
  7123.   my %pretty_print_style=
  7124.     ( none       => 0,          # no added \n
  7125.       nsgmls     => $NSGMLS,    # nsgmls-style, \n in tags
  7126.       # below this line styles are UNSAFE (the generated XML can be well-formed but invalid)
  7127.       nice       => $NICE,      # \n after open/close tags except when the 
  7128.                                 # element starts with text
  7129.       indented   => $INDENTED,  # nice plus idented
  7130.       indented_c => $INDENTEDC, # slightly more compact than indented (closing
  7131.                                 # tags are on the same line)
  7132.       wrapped    => $WRAPPED,   # text is wrapped at column 
  7133.       record_c   => $RECORD1,   # for record-like data (compact)
  7134.       record     => $RECORD2,   # for record-like data  (not so compact)
  7135.       indented_a => $INDENTEDA, # nice, indented, and with attributes on separate
  7136.                                 # lines as the nsgmls style, as well as wrapped
  7137.                                 # lines - to make the xml friendly to line-oriented tools
  7138.       cvs        => $INDENTEDA, # alias for indented_a
  7139.     );
  7140.  
  7141.   my ($HTML, $EXPAND)= (1..2);
  7142.   my %empty_tag_style=
  7143.     ( normal => 0,        # <tag/>
  7144.       html   => $HTML,    # <tag />
  7145.       xhtml  => $HTML,    # <tag />
  7146.       expand => $EXPAND,  # <tag></tag>
  7147.     );
  7148.  
  7149.   my %quote_style=
  7150.     ( double  => '"',    
  7151.       single  => "'", 
  7152.       # smart  => "smart", 
  7153.     );
  7154.  
  7155.   my $xml_space_preserve; # set when an element includes xml:space="preserve"
  7156.  
  7157.   my $output_filter;      # filters the entire output (including < and >)
  7158.   my $output_text_filter; # filters only the text part (tag names, attributes, pcdata)
  7159.  
  7160.  
  7161.   # returns those pesky "global" variables so you can switch between twigs 
  7162.   sub global_state
  7163.     { return
  7164.        { pretty                    => $pretty,
  7165.          quote                     => $quote,
  7166.          indent                    => $INDENT,
  7167.          empty_tag_style           => $empty_tag_style,
  7168.          remove_cdata              => $remove_cdata,
  7169.          keep_encoding             => $keep_encoding,
  7170.          expand_external_entities  => $expand_external_entities,
  7171.          output_filter             => $output_filter,
  7172.          output_text_filter        => $output_text_filter,
  7173.          keep_atts_order           => $keep_atts_order,
  7174.          do_not_escape_amp_in_atts => $do_not_escape_amp_in_atts,
  7175.          wrap                      => $WRAP,
  7176.         };
  7177.     }
  7178.  
  7179.   # restores the global variables
  7180.   sub set_global_state
  7181.     { my $state= shift;
  7182.       $pretty                    = $state->{pretty};
  7183.       $quote                     = $state->{quote};
  7184.       $INDENT                    = $state->{indent};
  7185.       $empty_tag_style           = $state->{empty_tag_style};
  7186.       $remove_cdata              = $state->{remove_cdata};
  7187.       $keep_encoding             = $state->{keep_encoding};
  7188.       $expand_external_entities  = $state->{expand_external_entities};
  7189.       $output_filter             = $state->{output_filter};
  7190.       $output_text_filter        = $state->{output_text_filter};
  7191.       $keep_atts_order           = $state->{keep_atts_order};
  7192.       $do_not_escape_amp_in_atts = $state->{do_not_escape_amp_in_atts};
  7193.       $WRAP                      = $state->{wrap};
  7194.     }
  7195.  
  7196.   # sets global state to defaults
  7197.   sub init_global_state
  7198.     { set_global_state(
  7199.        { pretty                    => 0,
  7200.          quote                     => '"',
  7201.          indent                    => $INDENT,
  7202.          empty_tag_style           => 0,
  7203.          remove_cdata              => 0,
  7204.          keep_encoding             => 0,
  7205.          expand_external_entities  => 0,
  7206.          output_filter             => undef,
  7207.          output_text_filter        => undef,
  7208.          keep_atts_order           => undef,
  7209.          do_not_escape_amp_in_atts => 0,
  7210.          wrap                      => $WRAP,
  7211.         });
  7212.     }
  7213.  
  7214.  
  7215.   # set the pretty_print style (in $pretty) and returns the old one
  7216.   # can be called from outside the package with 2 arguments (elt, style)
  7217.   # or from inside with only one argument (style)
  7218.   # the style can be either a string (one of the keys of %pretty_print_style
  7219.   # or a number (presumably an old value saved)
  7220.   sub set_pretty_print
  7221.     { my $style= lc( defined $_[1] ? $_[1] : $_[0]); # so we cover both cases 
  7222.       my $old_pretty= $pretty;
  7223.       if( $style=~ /^\d+$/)
  7224.         { croak "invalid pretty print style $style"
  7225.         unless( $style < keys %pretty_print_style);
  7226.         $pretty= $style;
  7227.     }
  7228.       else
  7229.         { croak "invalid pretty print style '$style'"
  7230.             unless( exists $pretty_print_style{$style});
  7231.           $pretty= $pretty_print_style{$style};
  7232.     }
  7233.       if( ($pretty == $WRAPPED) || ($pretty == $INDENTEDA) )
  7234.         { XML::Twig::_use( 'Text::Wrap') or croak( "Text::Wrap not available, cannot use 'wrapped' style"); }
  7235.       return $old_pretty;
  7236.     }
  7237.   
  7238.   
  7239.   # set the empty tag style (in $empty_tag_style) and returns the old one
  7240.   # can be called from outside the package with 2 arguments (elt, style)
  7241.   # or from inside with only one argument (style)
  7242.   # the style can be either a string (one of the keys of %empty_tag_style
  7243.   # or a number (presumably an old value saved)
  7244.   sub set_empty_tag_style
  7245.     { my $style= lc( defined $_[1] ? $_[1] : $_[0]); # so we cover both cases 
  7246.       my $old_style= $empty_tag_style;
  7247.       if( $style=~ /^\d+$/)
  7248.         { croak "invalid empty tag style $style"
  7249.         unless( $style < keys %empty_tag_style);
  7250.         $empty_tag_style= $style;
  7251.         }
  7252.       else
  7253.         { croak "invalid empty tag style '$style'"
  7254.             unless( exists $empty_tag_style{$style});
  7255.           $empty_tag_style= $empty_tag_style{$style};
  7256.         }
  7257.       return $old_style;
  7258.     }
  7259.       
  7260.   sub set_quote
  7261.     { my $style= $_[1] || $_[0];
  7262.       my $old_quote= $quote;
  7263.       croak "invalid quote '$style'" unless( exists $quote_style{$style});
  7264.       $quote= $quote_style{$style};
  7265.       return $old_quote;
  7266.     }
  7267.     
  7268.   sub set_remove_cdata
  7269.     { my $new_value= defined $_[1] ? $_[1] : $_[0];
  7270.       my $old_value= $remove_cdata;
  7271.       $remove_cdata= $new_value;
  7272.       return $old_value;
  7273.     }
  7274.       
  7275.       
  7276.   sub set_indent
  7277.     { my $new_value= defined $_[1] ? $_[1] : $_[0];
  7278.       my $old_value= $INDENT;
  7279.       $INDENT= $new_value;
  7280.       return $old_value;
  7281.     }
  7282.  
  7283.   sub set_wrap
  7284.     { my $new_value= defined $_[1] ? $_[1] : $_[0];
  7285.       my $old_value= $WRAP;
  7286.       $WRAP= $new_value;
  7287.       return $old_value;
  7288.     }
  7289.        
  7290.        
  7291.   sub set_keep_encoding
  7292.     { my $new_value= defined $_[1] ? $_[1] : $_[0];
  7293.       my $old_value= $keep_encoding;
  7294.       $keep_encoding= $new_value;
  7295.       return $old_value;
  7296.    }
  7297.  
  7298.   sub _keep_encoding { return $keep_encoding; } # so I can use elsewhere in the module
  7299.  
  7300.   sub set_do_not_escape_amp_in_atts
  7301.     { my $new_value= defined $_[1] ? $_[1] : $_[0];
  7302.       my $old_value= $do_not_escape_amp_in_atts;
  7303.       $do_not_escape_amp_in_atts= $new_value;
  7304.       return $old_value;
  7305.    }
  7306.  
  7307.   sub output_filter      { return $output_filter; }
  7308.   sub output_text_filter { return $output_text_filter; }
  7309.  
  7310.   sub set_output_filter
  7311.     { my $new_value= defined $_[1] ? $_[1] : $_[0]; # can be called in object/non-object mode
  7312.       # if called in object mode with no argument, the filter is undefined
  7313.       if( isa( $new_value, 'XML::Twig::Elt') || isa( $new_value, 'XML::Twig')) { undef $new_value; }
  7314.       my $old_value= $output_filter;
  7315.       if( !$new_value || isa( $new_value, 'CODE') )
  7316.         { $output_filter= $new_value; }
  7317.       elsif( $new_value eq 'latin1')
  7318.         { $output_filter= XML::Twig::latin1();
  7319.         }
  7320.       elsif( $XML::Twig::filter{$new_value})
  7321.         {  $output_filter= $XML::Twig::filter{$new_value}; }
  7322.       else
  7323.         { croak "invalid output filter '$new_value'"; }
  7324.       
  7325.       return $old_value;
  7326.     }
  7327.        
  7328.   sub set_output_text_filter
  7329.     { my $new_value= defined $_[1] ? $_[1] : $_[0]; # can be called in object/non-object mode
  7330.       # if called in object mode with no argument, the filter is undefined
  7331.       if( isa( $new_value, 'XML::Twig::Elt') || isa( $new_value, 'XML::Twig')) { undef $new_value; }
  7332.       my $old_value= $output_text_filter;
  7333.       if( !$new_value || isa( $new_value, 'CODE') )
  7334.         { $output_text_filter= $new_value; }
  7335.       elsif( $new_value eq 'latin1')
  7336.         { $output_text_filter= XML::Twig::latin1();
  7337.         }
  7338.       elsif( $XML::Twig::filter{$new_value})
  7339.         {  $output_text_filter= $XML::Twig::filter{$new_value}; }
  7340.       else
  7341.         { croak "invalid output text filter '$new_value'"; }
  7342.       
  7343.       return $old_value;
  7344.     }
  7345.        
  7346.   sub set_expand_external_entities
  7347.     { my $new_value= defined $_[1] ? $_[1] : $_[0];
  7348.       my $old_value= $expand_external_entities;
  7349.       $expand_external_entities= $new_value;
  7350.       return $old_value;
  7351.     }
  7352.        
  7353.   sub set_keep_atts_order
  7354.     { my $new_value= defined $_[1] ? $_[1] : $_[0];
  7355.       my $old_value= $keep_atts_order;
  7356.       $keep_atts_order= $new_value;
  7357.       return $old_value;
  7358.     
  7359.    }
  7360.  
  7361.   sub keep_atts_order { return $keep_atts_order; } # so I can use elsewhere in the module
  7362.  
  7363.   my %html_empty_elt;
  7364.   BEGIN { %html_empty_elt= map { $_ => 1} qw( base meta link hr br param img area input col); }
  7365.  
  7366.   sub start_tag
  7367.     { my( $elt, $option)= @_;
  7368.   
  7369.       return if( $elt->{gi} < $XML::Twig::SPECIAL_GI);
  7370.  
  7371.       my $extra_data= $elt->{extra_data} || '';
  7372.  
  7373.       my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
  7374.       my $att= $elt->{att}; # should be $elt->atts, optimized into a pure hash look-up
  7375.  
  7376.       my $ns_map= $att ? $elt->{'att'}->{'#original_gi'} : '';
  7377.       if( $ns_map) { $gi= _restore_original_prefix( $ns_map, $gi); }
  7378.       $gi=~ s{^#default:}{}; # remove default prefix
  7379.  
  7380.       if( $output_text_filter) { $gi= $output_text_filter->( $gi); }
  7381.   
  7382.       # get the attribute and their values
  7383.       my $att_sep = $pretty==$NSGMLS    ? "\n"
  7384.                   : $pretty==$INDENTEDA ? "\n" . $INDENT x ($elt->level+1) . '  '
  7385.                   :                       ' '
  7386.                   ;
  7387.  
  7388.       my $replace= $option->{escape_gt} ? qq{<>$quote&} : qq{<$quote&};
  7389.  
  7390.       my $tag;
  7391.       my @att_names= grep { !( (substr( $_, 0, 1) eq '#') && (substr( $_, 0, 9) ne '#default:') ) } $keep_atts_order ?  keys %{$att} : sort keys %{$att};
  7392.       if( @att_names)
  7393.         { my $atts= join $att_sep, map  { my $output_att_name= $ns_map ? _restore_original_prefix( $ns_map, $_) : $_;
  7394.                                           if( $output_text_filter)
  7395.                                             { $output_att_name=  $output_text_filter->( $output_att_name); }
  7396.                                           sprintf( "%s=%s%s%s", $output_att_name, 
  7397.                                                                 $quote,
  7398.                                                                  _att_xml_string( $att->{$_}, $replace), 
  7399.                                                                  $quote
  7400.                                                  );
  7401.                                         } 
  7402.                                         @att_names
  7403.                                    ;
  7404.            if( $pretty==$INDENTEDA && @att_names == 1) { $att_sep= ' '; }
  7405.            $tag= "<$gi$att_sep$atts";
  7406.         }
  7407.       else
  7408.         { $tag= "<$gi"; }
  7409.   
  7410.       $tag .= "\n" if($pretty==$NSGMLS);
  7411.  
  7412.       # force empty if suitable HTML tag, otherwise use the value from the input tree
  7413.       if( ($empty_tag_style eq $HTML) && !$elt->{first_child} && !$elt->_extra_data_before_end_tag && $html_empty_elt{$gi})
  7414.         { $elt->{empty}= 1; }
  7415.  
  7416.       $tag .= (!$elt->{empty} || $elt->_extra_data_before_end_tag)  ? '>'            # element has content
  7417.             : (($empty_tag_style eq $HTML) && $html_empty_elt{$gi}) ? ' />'          # html empty element 
  7418.                                                                                      # cvs-friendly format
  7419.             : ( $pretty == $INDENTEDA && @att_names > 1)            ? "\n" .  $INDENT x $elt->level . "/>"  
  7420.             : ( $pretty == $INDENTEDA && @att_names == 1)           ? " />"  
  7421.             : $empty_tag_style                                      ? "></$XML::Twig::index2gi[$elt->{'gi'}]>" # $empty_tag_style is $HTML or $EXPAND
  7422.             :                                                         '/>'
  7423.             ;
  7424.  
  7425.       if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') )) { $tag= ''; }
  7426.  
  7427.       unless( $pretty) { return defined( $extra_data) ? $extra_data . $tag : $tag;  }
  7428.  
  7429.       my $prefix='';
  7430.       my $return='';   # '' or \n is to be printed before the tag
  7431.       my $indent=0;    # number of indents before the tag
  7432.  
  7433.       if( $pretty==$RECORD1)
  7434.         { my $level= $elt->level;
  7435.           $return= "\n" if( $level < 2);
  7436.           $indent= 1 if( $level == 1);
  7437.         }
  7438.  
  7439.      elsif( $pretty==$RECORD2)
  7440.         { $return= "\n";
  7441.           $indent= $elt->level;
  7442.         }
  7443.  
  7444.       elsif( $pretty==$NICE)
  7445.         { my $parent= $elt->{parent};
  7446.           unless( !$parent || $parent->{contains_text}) 
  7447.             { $return= "\n"; }
  7448.           $elt->{contains_text}= 1 if( ($parent && $parent->{contains_text})
  7449.                                      || $elt->contains_text);
  7450.         }
  7451.  
  7452.       elsif( ($pretty==$INDENTED) || ($pretty==$INDENTEDC) || ($pretty==$INDENTEDA) || ($pretty==$WRAPPED))
  7453.         { my $parent= $elt->{parent};
  7454.           unless( !$parent || $parent->{contains_text}) 
  7455.             { $return= "\n"; 
  7456.               $indent= $elt->level; 
  7457.             }
  7458.           $elt->{contains_text}= 1 if( ($parent && $parent->{contains_text})
  7459.                                      || $elt->contains_text);
  7460.         }
  7461.  
  7462.       if( $return || $indent)
  7463.         { # check for elements in which spaces should be kept
  7464.           my $t= $elt->twig;
  7465.           return $extra_data . $tag if( $xml_space_preserve);
  7466.           if( $t && $t->{twig_keep_spaces_in})
  7467.             { foreach my $ancestor ($elt->ancestors)
  7468.                 { return $extra_data . $tag if( $t->{twig_keep_spaces_in}->{$XML::Twig::index2gi[$ancestor->{'gi'}]}) }
  7469.             }
  7470.         
  7471.           $prefix= $INDENT x $indent;
  7472.           if( $extra_data)
  7473.             { $extra_data=~ s{\s+$}{};
  7474.               $extra_data=~ s{^\s+}{};
  7475.               $extra_data= $prefix .  $extra_data . $return;
  7476.             }
  7477.         }
  7478.  
  7479.  
  7480.       return $return . $extra_data . $prefix . $tag;
  7481.     }
  7482.   
  7483.   sub end_tag
  7484.     { my $elt= shift;
  7485.       return  '' if(    ($elt->{gi}<$XML::Twig::SPECIAL_GI) 
  7486.                      || (($elt->{'empty'} || 0) && !$elt->_extra_data_before_end_tag)
  7487.                    );
  7488.       my $tag= "<";
  7489.       my $gi= $XML::Twig::index2gi[$elt->{'gi'}];
  7490.  
  7491.       if( my $map= $elt->{'att'}->{'#original_gi'}) { $gi= _restore_original_prefix( $map, $gi); }
  7492.       $gi=~ s{^#default:}{}; # remove default prefix
  7493.  
  7494.       if( $output_text_filter) { $gi= $output_text_filter->( $XML::Twig::index2gi[$elt->{'gi'}]); } 
  7495.       $tag .=  "/$gi>";
  7496.  
  7497.       $tag = ($elt->_extra_data_before_end_tag || '') . $tag;
  7498.  
  7499.       if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') )) { $tag= ''; }
  7500.  
  7501.       return $tag unless $pretty;
  7502.  
  7503.       my $prefix='';
  7504.       my $return=0;    # 1 if a \n is to be printed before the tag
  7505.       my $indent=0;    # number of indents before the tag
  7506.  
  7507.       if( $pretty==$RECORD1)
  7508.         { $return= 1 if( $elt->level == 0);
  7509.         }
  7510.  
  7511.      elsif( $pretty==$RECORD2)
  7512.         { unless( $elt->contains_text)
  7513.             { $return= 1 ;
  7514.               $indent= $elt->level;
  7515.             }
  7516.         }
  7517.  
  7518.       elsif( $pretty==$NICE)
  7519.         { my $parent= $elt->{parent};
  7520.           if( (    ($parent && !$parent->{contains_text}) || !$parent )
  7521.             && ( !$elt->{contains_text}  
  7522.              && ($elt->{has_flushed_child} || $elt->_first_child())           
  7523.            )
  7524.          )
  7525.             { $return= 1; }
  7526.         }
  7527.  
  7528.       elsif( ($pretty==$INDENTED) || ($pretty==$INDENTEDC) || ($pretty==$INDENTEDA) || ($pretty==$WRAPPED) )
  7529.         { my $parent= $elt->{parent};
  7530.           if( (    ($parent && !$parent->{contains_text}) || !$parent )
  7531.             && ( !$elt->{contains_text}  
  7532.              && ($elt->{has_flushed_child} || $elt->_first_child())           
  7533.            )
  7534.          )
  7535.             { $return= 1; 
  7536.               $indent= $elt->level; 
  7537.             }
  7538.         }
  7539.  
  7540.       if( $return || $indent)
  7541.         { # check for elements in which spaces should be kept
  7542.           my $t= $elt->twig;
  7543.           return $tag if( $xml_space_preserve);
  7544.           if( $t && $t->{twig_keep_spaces_in})
  7545.             { foreach my $ancestor ($elt, $elt->ancestors)
  7546.                 { return $tag if( $t->{twig_keep_spaces_in}->{$XML::Twig::index2gi[$ancestor->{'gi'}]}) }
  7547.             }
  7548.       
  7549.           $prefix= "\n" if( $return);
  7550.           $prefix.= $INDENT x $indent;
  7551.     }
  7552.  
  7553.       # add a \n at the end of the document (after the root element)
  7554.       $tag .= "\n" unless( $elt->{parent});
  7555.   
  7556.       return $prefix . $tag;
  7557.     }
  7558.  
  7559.   sub _restore_original_prefix
  7560.     { my( $map, $name)= @_;
  7561.       my $prefix= _ns_prefix( $name);
  7562.       if( my $original_prefix= $map->{$prefix})
  7563.         { if( $original_prefix eq '#default')
  7564.             { $name=~ s{^$prefix:}{}; }
  7565.           else
  7566.             { $name=~ s{^$prefix(?=:)}{$original_prefix}; }
  7567.         }
  7568.       return $name;
  7569.     }
  7570.  
  7571.   # $elt is an element to print
  7572.   # $fh is an optional filehandle to print to
  7573.   # $pretty is an optional value, if true a \n is printed after the < of the
  7574.   # opening tag
  7575.   sub print
  7576.     { my $elt= shift;
  7577.   
  7578.       my $pretty;
  7579.       my $fh= _is_fh( $_[0]) ? shift : undef;
  7580.       my $old_select= defined $fh ? select $fh : undef;
  7581.       my $old_pretty= defined ($pretty= shift) ? set_pretty_print( $pretty) : undef;
  7582.  
  7583.       $xml_space_preserve= 1 if( ($elt->inherit_att( 'xml:space') || '') eq 'preserve');
  7584.  
  7585.       #$elt->_print;
  7586.       print $elt->sprint;
  7587.  
  7588.       $xml_space_preserve= 0;
  7589.     
  7590.       select $old_select if( defined $old_select);
  7591.       set_pretty_print( $old_pretty) if( defined $old_pretty);
  7592.     }
  7593.       
  7594.   
  7595.   # same as print but does not output the start tag if the element
  7596.   # is marked as flushed
  7597.   sub flush 
  7598.     { my $elt= shift; 
  7599.       my $up_to= $_[0] && isa( $_[0], 'XML::Twig::Elt') ? shift : $elt;
  7600.       $elt->twig->flush_up_to( $up_to, @_); 
  7601.     }
  7602.   sub purge
  7603.     { my $elt= shift; 
  7604.       my $up_to= $_[0] && isa( $_[0], 'XML::Twig::Elt') ? shift : $elt;
  7605.       $elt->twig->purge_up_to( $up_to, @_); 
  7606.     }
  7607.   
  7608.   sub _flush
  7609.     { my $elt= shift;
  7610.   
  7611.       my $pretty;
  7612.       my $fh=  _is_fh( $_[0]) ? shift : undef;
  7613.       my $old_select= defined $fh ? select $fh : undef;
  7614.       my $old_pretty= defined ($pretty= shift) ? set_pretty_print( $pretty) : undef;
  7615.  
  7616.       $xml_space_preserve= 1 if( ($elt->inherit_att( 'xml:space') || '') eq 'preserve');
  7617.  
  7618.       $elt->__flush();
  7619.  
  7620.       $xml_space_preserve= 0;
  7621.  
  7622.       select $old_select if( defined $old_select);
  7623.       set_pretty_print( $old_pretty) if( defined $old_pretty);
  7624.     }
  7625.  
  7626.   sub __flush
  7627.     { my $elt= shift;
  7628.   
  7629.       if( $elt->{gi} >= $XML::Twig::SPECIAL_GI)
  7630.         { my $preserve= ($elt->{'att'}->{'xml:space'} || '') eq 'preserve';
  7631.           $xml_space_preserve++ if $preserve;
  7632.           unless( $elt->_flushed)
  7633.             { print $elt->start_tag();
  7634.             }
  7635.       
  7636.           # flush the children
  7637.           my @children= $elt->_children;
  7638.           foreach my $child (@children)
  7639.             { $child->_flush( $pretty); }
  7640.           print $elt->end_tag;
  7641.           $xml_space_preserve-- if $preserve;
  7642.           # used for pretty printing
  7643.           if( my $parent= $elt->{parent}) { $parent->{has_flushed_child}= 1; }
  7644.         }
  7645.       else # text or special element
  7646.         { my $text;
  7647.           if( (exists $elt->{'pcdata'}))     { $text= $elt->pcdata_xml_string; 
  7648.                                      if( my $parent= $elt->{parent}) 
  7649.                                        { $parent->{contains_text}= 1; }
  7650.                                    }
  7651.           elsif( (exists $elt->{'cdata'}))   { $text= $elt->cdata_string;        
  7652.                                      if( my $parent= $elt->{parent}) 
  7653.                                        { $parent->{contains_text}= 1; }
  7654.                                    }
  7655.           elsif( (exists $elt->{'target'}))      { $text= $elt->pi_string;          }
  7656.           elsif( (exists $elt->{'comment'})) { $text= $elt->comment_string;     }
  7657.           elsif( (exists $elt->{'ent'}))     { $text= $elt->ent_string;         }
  7658.  
  7659.           print $output_filter ? $output_filter->( $text) : $text;
  7660.         }
  7661.     }
  7662.   
  7663.  
  7664.   sub xml_text
  7665.     { my( $elt, @options)= @_;
  7666.  
  7667.       if( @options && grep { lc( $_) eq 'no_recurse' } @options) { return $elt->xml_text_only; }
  7668.  
  7669.       my $string='';
  7670.  
  7671.       if( ($elt->{gi} >= $XML::Twig::SPECIAL_GI) )
  7672.         { # sprint the children
  7673.           my $child= $elt->{first_child} || '';
  7674.           while( $child)
  7675.             { $string.= $child->xml_text;
  7676.             } continue { $child= $child->{next_sibling}; }
  7677.         }
  7678.       elsif( (exists $elt->{'pcdata'}))  { $string .= $output_filter ?  $output_filter->($elt->pcdata_xml_string) 
  7679.                                                            : $elt->pcdata_xml_string; 
  7680.                                }
  7681.       elsif( (exists $elt->{'cdata'}))   { $string .= $output_filter ?  $output_filter->($elt->cdata_xml_string)  
  7682.                                                            : $elt->cdata_string;      
  7683.                                }
  7684.       elsif( (exists $elt->{'ent'}))     { $string .= $elt->ent_string; }
  7685.  
  7686.       return $string;
  7687.     }
  7688.  
  7689.   sub xml_text_only
  7690.     { return join '', map { $_->xml_text if( $_->is_text || (exists $_->{'ent'})) } $_[0]->_children; }
  7691.  
  7692.   # same as print but except... it does not print but rather returns the string
  7693.   # if the second parameter is set then only the content is returned, not the
  7694.   # start and end tags of the element (but the tags of the included elements are
  7695.   # returned)
  7696.   sub sprint
  7697.     { my $elt= shift;
  7698.       my( $old_pretty, $old_empty_tag_style);
  7699.  
  7700.       if( $_[0] && isa( $_[0], 'HASH'))
  7701.         { my %args= XML::Twig::_normalize_args( %{shift()}); 
  7702.           if( defined $args{PrettyPrint}) { $old_pretty          = set_pretty_print( $args{PrettyPrint});  }
  7703.            if( defined $args{EmptyTags})  { $old_empty_tag_style = set_empty_tag_style( $args{EmptyTags}); }
  7704.         }
  7705.  
  7706.       $xml_space_preserve= 1 if( ($elt->inherit_att( 'xml:space') || '') eq 'preserve');
  7707.  
  7708.       my $sprint= $output_filter ? $output_filter->( $elt->_sprint( @_)) : $elt->_sprint( @_);
  7709.  
  7710.       if( ( ($pretty== $WRAPPED) || ($pretty==$INDENTEDC)) && !$xml_space_preserve)
  7711.         { $sprint= _wrap_text( $sprint); }
  7712.       $xml_space_preserve= 0;
  7713.  
  7714.  
  7715.       if( defined $old_pretty)          { set_pretty_print( $old_pretty);             } 
  7716.       if( defined $old_empty_tag_style) { set_empty_tag_style( $old_empty_tag_style); }
  7717.  
  7718.       return $sprint;
  7719.     }
  7720.   
  7721.   sub _wrap_text
  7722.     { my( $string)= @_;
  7723.       my $wrapped;
  7724.       foreach my $line (split /\n/, $string)
  7725.         { my( $initial_indent)= $line=~ m{^(\s*)};
  7726.           my $wrapped_line= Text::Wrap::wrap(  '',  $initial_indent . $INDENT, $line) . "\n";
  7727.           
  7728.           # fix glitch with Text::wrap when the first line is long and does not include spaces
  7729.           # the first line ends up being too short by 2 chars, but we'll have to live with it!
  7730.           $wrapped_line=~ s{^ +\n  }{}s; # this prefix needs to be removed
  7731.       
  7732.           $wrapped .= $wrapped_line;
  7733.         }
  7734.      
  7735.       return $wrapped;
  7736.     }
  7737.       
  7738.   
  7739.   sub _sprint
  7740.     { my $elt= shift;
  7741.       my $no_tag= shift || 0;
  7742.       # in case there's some comments or PI's piggybacking
  7743.       my $string='';
  7744.  
  7745.       if( $elt->{gi} >= $XML::Twig::SPECIAL_GI)
  7746.         {
  7747.           my $preserve= ($elt->{'att'}->{'xml:space'} || '') eq 'preserve';
  7748.           $xml_space_preserve++ if $preserve;
  7749.  
  7750.           $string.= $elt->start_tag unless( $no_tag);
  7751.       
  7752.           # sprint the children
  7753.           my $child= $elt->{first_child};
  7754.           while( $child)
  7755.             { $string.= $child->_sprint;
  7756.               $child= $child->{next_sibling};
  7757.             }
  7758.           $string.= $elt->end_tag unless( $no_tag);
  7759.           $xml_space_preserve-- if $preserve;
  7760.         }
  7761.       else
  7762.         { $string .= $elt->{extra_data} || '';
  7763.           if(    (exists $elt->{'pcdata'}))  { $string .= $elt->pcdata_xml_string; }
  7764.           elsif( (exists $elt->{'cdata'}))   { $string .= $elt->cdata_string;      }
  7765.           elsif( (exists $elt->{'target'}))      { $string .= $elt->pi_string;
  7766.                                      if( ($pretty >= $INDENTED) && !$elt->{parent}->{contains_text}) { $string .= "\n"; }
  7767.                                    }
  7768.           elsif( (exists $elt->{'comment'})) { $string .= $elt->comment_string;    
  7769.                                      if( ($pretty >= $INDENTED) && !$elt->{parent}->{contains_text}) { $string .= "\n"; }
  7770.                                    }
  7771.           elsif( (exists $elt->{'ent'}))     { $string .= $elt->ent_string;        }
  7772.         }
  7773.  
  7774.       return $string;
  7775.     }
  7776.  
  7777.   # just a shortcut to $elt->sprint( 1)
  7778.   sub xml_string
  7779.     { my $elt= shift;
  7780.       isa( $_[0], 'HASH') ?  $elt->sprint( shift(), 1) : $elt->sprint( 1);
  7781.     }
  7782.  
  7783.   sub pcdata_xml_string 
  7784.     { my $elt= shift;
  7785.       if( defined( my $string= $elt->{pcdata}) )
  7786.         { 
  7787.           if( $elt->_extra_data_in_pcdata)
  7788.             { _gen_mark( $string); # used by _(un)?protect_extra_data
  7789.               foreach my $data (reverse @{$elt->_extra_data_in_pcdata})
  7790.                 { my $substr= substr( $string, $data->{offset});
  7791.                   if( $keep_encoding || $elt->{asis})
  7792.                     { substr( $string, $data->{offset}, 0, $data->{text}); }
  7793.                   else
  7794.                     { substr( $string, $data->{offset}, 0, _protect_extra_data( $data->{text})); }
  7795.                 }
  7796.               unless( $keep_encoding || $elt->{asis})
  7797.                 { $string=~ s/([&<])/$XML::Twig::base_ent{$1}/g ;
  7798.                   $string=~ s{\Q]]>}{]]>}g;
  7799.                   _unprotect_extra_data( $string);
  7800.                 }
  7801.             }
  7802.           else
  7803.             { $string=~ s/([&<])/$XML::Twig::base_ent{$1}/g unless( $keep_encoding || $elt->{asis});  
  7804.               $string=~ s{\Q]]>}{]]>}g;
  7805.             }
  7806.           return $output_text_filter ? $output_text_filter->( $string) : $string;
  7807.         }
  7808.       else
  7809.         { return ''; }
  7810.     }
  7811.  
  7812.   { my $mark;
  7813.     my( %char2ent, %ent2char);
  7814.     BEGIN
  7815.       { %char2ent= ( '<' => 'lt', '&' => 'amp');
  7816.         %ent2char= ( 'lt' => '<', 'amp' => '&');
  7817.       }
  7818.  
  7819.     # generate a unique mark (a string) not found in the string, 
  7820.     # used to mark < and & in the extra data
  7821.     sub _gen_mark
  7822.       { $mark="AAAA";
  7823.         $mark++ while( index( $_[0], $mark) > -1);
  7824.         return $mark;
  7825.       }
  7826.       
  7827.     sub _protect_extra_data
  7828.       { my( $extra_data)= @_;
  7829.         $extra_data=~ s{([&<])}{:$mark:$char2ent{$1}:}g;
  7830.         return $extra_data;
  7831.       }
  7832.  
  7833.     sub _unprotect_extra_data
  7834.       { $_[0]=~ s{:$mark:(\w+):}{$ent2char{$1}}g; }
  7835.  
  7836.   } 
  7837.   
  7838.   sub cdata_string
  7839.     { my $cdata= $_[0]->{cdata};
  7840.       unless( defined $cdata) { return ''; }
  7841.       if( $remove_cdata)
  7842.         { $cdata=~ s/([&<])/$XML::Twig::base_ent{$1}/g; }
  7843.       else
  7844.         { $cdata= CDATA_START . $cdata . CDATA_END; }
  7845.       return $cdata;
  7846.    }
  7847.  
  7848.   sub att_xml_string 
  7849.     { my $elt= shift;
  7850.       my $att= shift;
  7851.       my $replace= $_[0] && $_[0]->{escape_gt} ? qq{<>$quote&} : qq{<$quote&};
  7852.       if( defined (my $string= $elt->{att}->{$att}))
  7853.         { return _att_xml_string( $string, $replace); }
  7854.       else
  7855.         { return ''; }
  7856.     }
  7857.     
  7858.   # escaped xml string for an attribute value
  7859.   sub _att_xml_string 
  7860.     { my( $string, $escape)= @_;
  7861.       if( !defined( $string)) { return ''; }
  7862.       unless( $keep_encoding)
  7863.         { 
  7864.           if( $do_not_escape_amp_in_atts)
  7865.             { $escape=~ s{.$}{}; # seems like the most backward compatible way to remove & from the list
  7866.               $string=~ s{([$escape])}{$XML::Twig::base_ent{$1}}g; 
  7867.               $string=~ s{&(?!(\w+|#\d+|[xX][0-9a-fA-F]+);)}{&}g; # dodgy: escape & that do not start an entity
  7868.             }
  7869.           else
  7870.             { $string=~ s{([$escape])}{$XML::Twig::base_ent{$1}}g; 
  7871.               $string=~ s{\Q]]>}{]]>}g;
  7872.             }
  7873.         }
  7874.       return $output_text_filter ? $output_text_filter->( $string) : $string;
  7875.     }
  7876.  
  7877.   sub ent_string 
  7878.     { my $ent= shift;
  7879.       my $ent_text= $ent->{ent};
  7880.       my( $t, $el, $ent_string);
  7881.       if(    $expand_external_entities
  7882.           && ($t= $ent->twig) 
  7883.           && ($el= $t->entity_list)
  7884.           && ($ent_string= $el->{entities}->{$ent->ent_name}->{val})
  7885.         )
  7886.         { return $ent_string; }
  7887.        else
  7888.          { return $ent_text;  }
  7889.     }
  7890.  
  7891.   # returns just the text, no tags, for an element
  7892.   sub text
  7893.     { my( $elt, @options)= @_;
  7894.  
  7895.       if( @options && grep { lc( $_) eq 'no_recurse' } @options) { return $elt->text_only; }
  7896.  
  7897.       my $string;
  7898.   
  7899.       if( (exists $elt->{'pcdata'}))     { return  $elt->{pcdata};   }
  7900.       elsif( (exists $elt->{'cdata'}))   { return  $elt->{cdata};    }
  7901.       elsif( (exists $elt->{'target'}))      { return  $elt->pi_string;}
  7902.       elsif( (exists $elt->{'comment'})) { return  $elt->{comment};  }
  7903.       elsif( (exists $elt->{'ent'}))     { return  $elt->{ent} ;     }
  7904.   
  7905.       my $child= $elt->{first_child} ||'';
  7906.       while( $child)
  7907.         {
  7908.           my $child_text= $child->text;
  7909.           $string.= defined( $child_text) ? $child_text : '';
  7910.         } continue { $child= $child->{next_sibling}; }
  7911.  
  7912.       unless( defined $string) { $string=''; }
  7913.  
  7914.       return $output_text_filter ? $output_text_filter->( $string) : $string;
  7915.     }
  7916.  
  7917.   sub text_only
  7918.     { return join '', map { $_->text if( $_->is_text || (exists $_->{'ent'})) } $_[0]->_children; }
  7919.  
  7920.   sub trimmed_text
  7921.     { my $elt= shift;
  7922.       my $text= $elt->text( @_);
  7923.       $text=~ s{\s+}{ }sg;
  7924.       $text=~ s{^\s*}{};
  7925.       $text=~ s{\s*$}{};
  7926.       return $text;
  7927.     }
  7928.  
  7929.   sub trim
  7930.     { my( $elt)= @_;
  7931.       my $pcdata= $elt->first_descendant( '#TEXT');
  7932.       (my $pcdata_text= $pcdata->text)=~ s{^\s+}{}s;
  7933.       $pcdata->set_text( $pcdata_text);
  7934.       $pcdata= $elt->last_descendant( '#TEXT');
  7935.       ($pcdata_text= $pcdata->text)=~ s{\s+$}{};
  7936.       $pcdata->set_text( $pcdata_text);
  7937.       foreach $pcdata ($elt->descendants( '#TEXT'))
  7938.         { ($pcdata_text= $pcdata->text)=~ s{\s+}{ }g;
  7939.           $pcdata->set_text( $pcdata_text);
  7940.         }
  7941.       return $elt;
  7942.     }
  7943.   
  7944.  
  7945.   # remove cdata sections (turns them into regular pcdata) in an element 
  7946.   sub remove_cdata 
  7947.     { my $elt= shift;
  7948.       foreach my $cdata ($elt->descendants_or_self( CDATA))
  7949.         { if( $keep_encoding)
  7950.             { my $data= $cdata->{cdata};
  7951.               $data=~ s{([&<"'])}{$XML::Twig::base_ent{$1}}g;
  7952.               $cdata->set_pcdata( $data);
  7953.             }
  7954.           else
  7955.             { $cdata->set_pcdata( $cdata->{cdata}); }
  7956.           $cdata->set_gi( PCDATA);
  7957.           undef $cdata->{cdata};
  7958.         }
  7959.     }
  7960.  
  7961. sub _is_private      { return _is_private_name( $_[0]->gi); }
  7962. sub _is_private_name { return $_[0]=~ m{^#(?!default:)};                }
  7963.  
  7964.  
  7965. } # end of block containing package globals ($pretty_print, $quotes, keep_encoding...)
  7966.  
  7967. sub normalize
  7968.   { my( $elt)= @_;
  7969.     my @descendants= $elt->descendants( '#PCDATA');
  7970.     while( my $desc= shift @descendants)
  7971.       { while( @descendants && $desc->{next_sibling} && $desc->{next_sibling}== $descendants[0])
  7972.           { my $to_merge= shift @descendants;
  7973.             $desc->{pcdata}.= $to_merge->{pcdata};
  7974.             $to_merge->delete;
  7975.           }
  7976.       }
  7977.     return $elt;
  7978.   }
  7979.  
  7980. # SAX export methods
  7981. sub toSAX1
  7982.   { _toSAX(@_, \&_start_tag_data_SAX1, \&_end_tag_data_SAX1); }
  7983.  
  7984. sub toSAX2
  7985.   { _toSAX(@_, \&_start_tag_data_SAX2, \&_end_tag_data_SAX2); }
  7986.  
  7987. sub _toSAX
  7988.   { my( $elt, $handler, $start_tag_data, $end_tag_data)= @_;
  7989.     if( $elt->{gi} >= $XML::Twig::SPECIAL_GI)
  7990.       { my $data= $start_tag_data->( $elt);
  7991.         _start_prefix_mapping( $elt, $handler, $data);
  7992.         if( $data && (my $start_element = $handler->can( 'start_element')))
  7993.           { $start_element->( $handler, $data) unless( $elt->_flushed); }
  7994.       
  7995.         foreach my $child ($elt->_children)
  7996.           { $child->_toSAX( $handler, $start_tag_data, $end_tag_data); }
  7997.  
  7998.         if( (my $data= $end_tag_data->( $elt)) && (my $end_element = $handler->can( 'end_element')) )
  7999.           { $end_element->( $handler, $data); }
  8000.         _end_prefix_mapping( $elt, $handler);
  8001.       }
  8002.     else # text or special element
  8003.       { if( (exists $elt->{'pcdata'}) && (my $characters= $handler->can( 'characters')))
  8004.           { $characters->( $handler, { Data => $elt->{pcdata} });  }
  8005.         elsif( (exists $elt->{'cdata'}))  
  8006.           { if( my $start_cdata= $handler->can( 'start_cdata'))
  8007.               { $start_cdata->( $handler); }
  8008.             if( my $characters= $handler->can( 'characters'))
  8009.               { $characters->( $handler, {Data => $elt->{cdata} });  }
  8010.             if( my $end_cdata= $handler->can( 'end_cdata'))
  8011.               { $end_cdata->( $handler); }
  8012.           }
  8013.         elsif( ((exists $elt->{'target'}))  && (my $pi= $handler->can( 'processing_instruction')))
  8014.           { $pi->( $handler, { Target =>$elt->{target}, Data => $elt->{data} });  }
  8015.         elsif( ((exists $elt->{'comment'}))  && (my $comment= $handler->can( 'comment')))
  8016.           { $comment->( $handler, { Data => $elt->{comment} });  }
  8017.         elsif( ((exists $elt->{'ent'})))
  8018.           { 
  8019.             if( my $se=   $handler->can( 'skipped_entity'))
  8020.               { $se->( $handler, { Name => $elt->ent_name });  }
  8021.             elsif( my $characters= $handler->can( 'characters'))
  8022.               { if( defined $elt->ent_string)
  8023.                   { $characters->( $handler, {Data => $elt->ent_string});  }
  8024.                 else
  8025.                   { $characters->( $handler, {Data => $elt->ent_name});  }
  8026.               }
  8027.           }
  8028.       
  8029.       }
  8030.   }
  8031.   
  8032. sub _start_tag_data_SAX1
  8033.   { my( $elt)= @_;
  8034.     my $name= $XML::Twig::index2gi[$elt->{'gi'}];
  8035.     return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
  8036.     my $attributes={};
  8037.     my $atts= $elt->atts;
  8038.     while( my( $att, $value)= each %$atts)
  8039.       { $attributes->{$att}= $value unless( ( (substr( $att, 0, 1) eq '#') && (substr( $att, 0, 9) ne '#default:') )); }
  8040.     my $data= { Name => $name, Attributes => $attributes};
  8041.     return $data;
  8042.   }
  8043.  
  8044. sub _end_tag_data_SAX1
  8045.   { my( $elt)= @_;
  8046.     return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
  8047.     return  { Name => $XML::Twig::index2gi[$elt->{'gi'}] };
  8048.   } 
  8049.   
  8050. sub _start_tag_data_SAX2
  8051.   { my( $elt)= @_;
  8052.     my $data={};
  8053.     
  8054.     my $name= $XML::Twig::index2gi[$elt->{'gi'}];
  8055.     return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
  8056.     $data->{Name}         = $name;
  8057.     $data->{Prefix}       = $elt->ns_prefix; 
  8058.     $data->{LocalName}    = $elt->local_name;
  8059.     $data->{NamespaceURI} = $elt->namespace;
  8060.  
  8061.     # save a copy of the data so we can re-use it for the end tag
  8062.     my %sax2_data= %$data;
  8063.     $elt->{twig_elt_SAX2_data}= \%sax2_data;
  8064.    
  8065.     # add the attributes
  8066.     $data->{Attributes}= $elt->_atts_to_SAX2;
  8067.  
  8068.     return $data;
  8069.   }
  8070.  
  8071. sub _atts_to_SAX2
  8072.   { my $elt= shift;
  8073.     my $SAX2_atts= {};
  8074.     foreach my $att (keys %{$elt->atts})
  8075.       { 
  8076.         next if( ( (substr( $att, 0, 1) eq '#') && (substr( $att, 0, 9) ne '#default:') ));
  8077.         my $SAX2_att={};
  8078.         $SAX2_att->{Name}         = $att;
  8079.         $SAX2_att->{Prefix}       = _ns_prefix( $att); 
  8080.         $SAX2_att->{LocalName}    = _local_name( $att);
  8081.         $SAX2_att->{NamespaceURI} = $elt->namespace( $SAX2_att->{Prefix});
  8082.         $SAX2_att->{Value}        = $elt->{'att'}->{$att};
  8083.         my $SAX2_att_name= "{$SAX2_att->{NamespaceURI}}$SAX2_att->{LocalName}";
  8084.  
  8085.         $SAX2_atts->{$SAX2_att_name}= $SAX2_att;
  8086.       }
  8087.     return $SAX2_atts;
  8088.   }
  8089.  
  8090. sub _start_prefix_mapping
  8091.   { my( $elt, $handler, $data)= @_;
  8092.     if( my $start_prefix_mapping= $handler->can( 'start_prefix_mapping')
  8093.         and my @new_prefix_mappings= grep { /^\{[^}]*\}xmlns/ || /^\{$XMLNS_URI\}/ } keys %{$data->{Attributes}}
  8094.       )
  8095.       { foreach my $prefix (@new_prefix_mappings)
  8096.           { my $prefix_string= $data->{Attributes}->{$prefix}->{LocalName};
  8097.             if( $prefix_string eq 'xmlns') { $prefix_string=''; }
  8098.             my $prefix_data=
  8099.               {  Prefix       => $prefix_string,
  8100.                  NamespaceURI => $data->{Attributes}->{$prefix}->{Value}
  8101.               };
  8102.             $start_prefix_mapping->( $handler, $prefix_data);
  8103.             $elt->{twig_end_prefix_mapping} ||= [];
  8104.             push @{$elt->{twig_end_prefix_mapping}}, $prefix_string;
  8105.           }
  8106.       }
  8107.   }
  8108.  
  8109. sub _end_prefix_mapping
  8110.   { my( $elt, $handler)= @_;
  8111.     if( my $end_prefix_mapping= $handler->can( 'end_prefix_mapping'))
  8112.       { foreach my $prefix (@{$elt->{twig_end_prefix_mapping}})
  8113.           { $end_prefix_mapping->( $handler, { Prefix => $prefix} ); }
  8114.       }
  8115.   }
  8116.              
  8117. sub _end_tag_data_SAX2
  8118.   { my( $elt)= @_;
  8119.     return if( ( (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 1) eq '#') && (substr( $XML::Twig::index2gi[$elt->{'gi'}], 0, 9) ne '#default:') ));
  8120.     return $elt->{twig_elt_SAX2_data};
  8121.   } 
  8122.  
  8123.  
  8124.  
  8125. #start-extract twig_node
  8126. sub contains_text
  8127.   { my $elt= shift;
  8128.     my $child= $elt->{first_child};
  8129.     while ($child)
  8130.       { return 1 if( $child->is_text || (exists $child->{'ent'})); 
  8131.         $child= $child->{next_sibling};
  8132.       }
  8133.     return 0;
  8134.   }
  8135.  
  8136. #end-extract twig_node
  8137.  
  8138. # creates a single pcdata element containing the text as child of the element
  8139. # options: 
  8140. #   - force_pcdata: when set to a true value forces the text to be in a #PCDATA
  8141. #                   even if the original element was a #CDATA
  8142. sub set_text
  8143.   { my( $elt, $string, %option)= @_;
  8144.  
  8145.     if( $XML::Twig::index2gi[$elt->{'gi'}] eq PCDATA) 
  8146.       { return $elt->set_pcdata( $string); }
  8147.     elsif( $XML::Twig::index2gi[$elt->{'gi'}] eq CDATA)  
  8148.       { if( $option{force_pcdata})
  8149.           { $elt->set_gi( PCDATA);
  8150.             $elt->_set_cdata('');
  8151.             return $elt->set_pcdata( $string);
  8152.           }
  8153.         else
  8154.           { return $elt->_set_cdata( $string); }
  8155.       }
  8156.     elsif( $elt->contains_a_single( PCDATA) )
  8157.       { # optimized so we have a slight chance of not loosing embedded comments and pi's
  8158.         return $elt->{first_child}->set_pcdata( $string);
  8159.       }
  8160.  
  8161.     foreach my $child (@{[$elt->_children]})
  8162.       { $child->delete; }
  8163.  
  8164.     my $pcdata= $elt->new( PCDATA, $string);
  8165.     $pcdata->paste( $elt);
  8166.  
  8167.     delete $elt->{empty};
  8168.  
  8169.     return $elt;
  8170.   }
  8171.  
  8172. # set the content of an element from a list of strings and elements
  8173. sub set_content
  8174.   { my $elt= shift;
  8175.  
  8176.     return $elt unless defined $_[0];
  8177.  
  8178.     # attributes can be given as a hash (passed by ref)
  8179.     if( ref $_[0] eq 'HASH')
  8180.       { my $atts= shift;
  8181.         $elt->del_atts; # usually useless but better safe than sorry
  8182.         $elt->set_atts( $atts);
  8183.         return  $elt unless defined $_[0];
  8184.       }
  8185.  
  8186.     # check next argument for #EMPTY
  8187.     if( !(ref $_[0]) && ($_[0] eq EMPTY) ) 
  8188.       { $elt->{empty}= 1; return $elt; }
  8189.  
  8190.     # case where we really want to do a set_text, the element is '#PCDATA'
  8191.     # or contains a single PCDATA and we only want to add text in it
  8192.     if( ($XML::Twig::index2gi[$elt->{'gi'}] eq PCDATA || $elt->contains_a_single( PCDATA)) 
  8193.         && (@_ == 1) && !( ref $_[0]))
  8194.       { $elt->set_text( $_[0]);
  8195.         return $elt;
  8196.       }
  8197.     elsif( ($XML::Twig::index2gi[$elt->{'gi'}] eq CDATA) && (@_ == 1) && !( ref $_[0]))
  8198.       { $elt->_set_cdata( $_[0]);
  8199.         return $elt;
  8200.       }
  8201.  
  8202.     # delete the children
  8203.     # WARNING: potential problem here if the children are used
  8204.     # somewhere else (where?). Will be solved when I use weak refs
  8205.     foreach my $child (@{[$elt->_children]})
  8206.       { $child->delete; }
  8207.  
  8208.     foreach my $child (@_)
  8209.       { if( isa( $child, 'XML::Twig::Elt'))
  8210.           { # argument is an element
  8211.             $child->paste( 'last_child', $elt);
  8212.           }
  8213.         else
  8214.           { # argument is a string
  8215.             if( (my $pcdata= $elt->{last_child}) && $elt->{last_child}->is_pcdata)
  8216.               { # previous child is also pcdata: just concatenate
  8217.                 $pcdata->set_pcdata( $pcdata->{pcdata} . $child) 
  8218.               }
  8219.             else
  8220.               { # previous child is not a string: creat a new pcdata element
  8221.                 $pcdata= $elt->new( PCDATA, $child);
  8222.                 $pcdata->paste( 'last_child', $elt);  
  8223.               }
  8224.           }
  8225.       }
  8226.  
  8227.     delete $elt->{empty};
  8228.  
  8229.     return $elt;
  8230.   }
  8231.  
  8232. # inserts an element (whose gi is given) as child of the element
  8233. # all children of the element are now children of the new element
  8234. # returns the new element
  8235. sub insert
  8236.   { my ($elt, @args)= @_;
  8237.     # first cut the children
  8238.     my @children= $elt->_children;
  8239.     foreach my $child (@children)
  8240.       { $child->cut; }
  8241.     # insert elements
  8242.     while( my $gi= shift @args)
  8243.       { my $new_elt= $elt->new( $gi);
  8244.         # add attributes if needed
  8245.         if( defined( $args[0]) && ( isa( $args[0], 'HASH')) )
  8246.           { $new_elt->set_atts( shift @args); }
  8247.         # paste the element
  8248.         $new_elt->paste( $elt);
  8249.         delete $elt->{empty};
  8250.         $elt= $new_elt;
  8251.       }
  8252.     # paste back the children
  8253.     foreach my $child (@children)
  8254.       { $child->paste( 'last_child', $elt); }
  8255.     return $elt;
  8256.   }
  8257.  
  8258. # insert a new element 
  8259. # $elt->insert_new_element( $opt_position, $gi, $opt_atts_hash, @opt_content); 
  8260. # the element is created with the same syntax as new
  8261. # position is the same as in paste, first_child by default
  8262. sub insert_new_elt
  8263.   { my $elt= shift;
  8264.     my $position= $_[0];
  8265.     if(     ($position eq 'before') || ($position eq 'after')
  8266.          || ($position eq 'first_child') || ($position eq 'last_child'))
  8267.       { shift; }
  8268.     else
  8269.       { $position= 'first_child'; }
  8270.  
  8271.     my $new_elt= $elt->new( @_);
  8272.     $new_elt->paste( $position, $elt);
  8273.  
  8274.     #if( defined $new_elt->{'att'}->{$ID}) { $new_elt->set_id( $new_elt->{'att'}->{$ID}); }
  8275.     
  8276.     return $new_elt;
  8277.   }
  8278.  
  8279. # wraps an element in elements which gi's are given as arguments
  8280. # $elt->wrap_in( 'td', 'tr', 'table') wraps the element as a single
  8281. # cell in a table for example
  8282. # returns the new element
  8283. sub wrap_in
  8284.   { my $elt= shift;
  8285.     while( my $gi = shift @_)
  8286.       { my $new_elt = $elt->new( $gi);
  8287.         if( $elt->{twig_current})
  8288.           { my $t= $elt->twig;
  8289.             $t->{twig_current}= $new_elt;
  8290.             delete $elt->{'twig_current'};
  8291.             $new_elt->{'twig_current'}=1;
  8292.           }
  8293.  
  8294.         if( my $parent= $elt->{parent})
  8295.           { $new_elt->set_parent( $parent); 
  8296.             $parent->{first_child}=  $new_elt if( $parent->{first_child} == $elt);
  8297.             $parent->set_last_child( $new_elt)  if( $parent->{last_child} == $elt);
  8298.           }
  8299.         else
  8300.           { # wrapping the root
  8301.             my $twig= $elt->twig;
  8302.             if( $twig && $twig->root && ($twig->root eq $elt) )
  8303.               { $twig->{twig_root}= $new_elt; }
  8304.           }
  8305.  
  8306.         if( my $prev_sibling= $elt->{prev_sibling})
  8307.           { $new_elt->set_prev_sibling( $prev_sibling);
  8308.             $prev_sibling->{next_sibling}=  $new_elt;
  8309.           }
  8310.  
  8311.         if( my $next_sibling= $elt->{next_sibling})
  8312.           { $new_elt->{next_sibling}=  $next_sibling;
  8313.             $next_sibling->set_prev_sibling( $new_elt);
  8314.           }
  8315.         $new_elt->{first_child}=  $elt;
  8316.         $new_elt->set_last_child( $elt);
  8317.  
  8318.         $elt->set_parent( $new_elt);
  8319.         $elt->set_prev_sibling( undef);
  8320.         $elt->{next_sibling}=  undef;
  8321.  
  8322.         # add the attributes if the next argument is a hash ref
  8323.         if( defined( $_[0]) && (isa( $_[0], 'HASH')) )
  8324.           { $new_elt->set_atts( shift @_); }
  8325.  
  8326.         $elt= $new_elt;
  8327.       }
  8328.       
  8329.     return $elt;
  8330.   }
  8331.  
  8332. sub replace
  8333.   { my( $elt, $ref)= @_;
  8334.     if( my $parent= $ref->{parent})
  8335.       { $elt->set_parent( $parent);
  8336.         $parent->{first_child}=  $elt if( $parent->{first_child} == $ref);
  8337.         $parent->set_last_child( $elt)  if( $parent->{last_child} == $ref);
  8338.       }
  8339.     if( my $prev_sibling= $ref->{prev_sibling})
  8340.       { $elt->set_prev_sibling( $prev_sibling);
  8341.         $prev_sibling->{next_sibling}=  $elt;
  8342.       }
  8343.     if( my $next_sibling= $ref->{next_sibling})
  8344.       { $elt->{next_sibling}=  $next_sibling;
  8345.         $next_sibling->set_prev_sibling( $elt);
  8346.       }
  8347.    
  8348.     $ref->set_parent( undef);
  8349.     $ref->set_prev_sibling( undef);
  8350.     $ref->{next_sibling}=  undef;
  8351.     return $ref;
  8352.   }
  8353.  
  8354. sub replace_with
  8355.   { my $ref= shift;
  8356.     my $elt= shift;
  8357.     $elt->replace( $ref);
  8358.     foreach my $new_elt (reverse @_)
  8359.       { $new_elt->paste( after => $elt); }
  8360.     return $elt;
  8361.   }
  8362.  
  8363.  
  8364. #start-extract twig_node
  8365. # move an element, same syntax as paste, except the element is first cut
  8366. sub move
  8367.   { my $elt= shift;
  8368.     $elt->cut;
  8369.     $elt->paste( @_);
  8370.     return $elt;
  8371.   }
  8372. #end-extract twig_node
  8373.  
  8374.  
  8375. # adds a prefix to an element, creating a pcdata child if needed
  8376. sub prefix
  8377.   { my ($elt, $prefix, $option)= @_;
  8378.     my $asis= ($option && ($option eq 'asis')) ? 1 : 0;
  8379.     if( (exists $elt->{'pcdata'}) 
  8380.         && (($asis && $elt->{asis}) || (!$asis && ! $elt->{asis}))
  8381.       )
  8382.       { $elt->set_pcdata( $prefix . $elt->{pcdata}); }
  8383.     elsif( $elt->{first_child} && $elt->{first_child}->is_pcdata
  8384.         && (   ($asis && $elt->{first_child}->{asis}) 
  8385.             || (!$asis && ! $elt->{first_child}->{asis}))
  8386.          )
  8387.       { 
  8388.         $elt->{first_child}->set_pcdata( $prefix . $elt->{first_child}->pcdata); 
  8389.       }
  8390.     else
  8391.       { my $new_elt= $elt->new( PCDATA, $prefix);
  8392.         $new_elt->paste( $elt);
  8393.         $new_elt->set_asis if( $asis);
  8394.       }
  8395.     return $elt;
  8396.   }
  8397.  
  8398. # adds a suffix to an element, creating a pcdata child if needed
  8399. sub suffix
  8400.   { my ($elt, $suffix, $option)= @_;
  8401.     my $asis= ($option && ($option eq 'asis')) ? 1 : 0;
  8402.     if( (exists $elt->{'pcdata'})
  8403.         && (($asis && $elt->{asis}) || (!$asis && ! $elt->{asis}))
  8404.       )
  8405.       { $elt->set_pcdata( $elt->{pcdata} . $suffix); }
  8406.     elsif( $elt->{last_child} && $elt->{last_child}->is_pcdata
  8407.         && (   ($asis && $elt->{last_child}->{asis}) 
  8408.             || (!$asis && ! $elt->{last_child}->{asis}))
  8409.          )
  8410.       { $elt->{last_child}->set_pcdata( $elt->{last_child}->pcdata . $suffix); }
  8411.     else
  8412.       { my $new_elt= $elt->new( PCDATA, $suffix);
  8413.         $new_elt->paste( 'last_child', $elt);
  8414.         $new_elt->set_asis if( $asis);
  8415.       }
  8416.     return $elt;
  8417.   }
  8418.  
  8419. #start-extract twig_node
  8420. # create a path to an element ('/root/.../gi)
  8421. sub path
  8422.   { my $elt= shift;
  8423.     my @context= ( $elt, $elt->ancestors);
  8424.     return "/" . join( "/", reverse map {$_->gi} @context);
  8425.   }
  8426.  
  8427. sub xpath
  8428.   { my $elt= shift;
  8429.     my $xpath;
  8430.     foreach my $ancestor (reverse $elt->ancestors_or_self)
  8431.       { my $gi= $XML::Twig::index2gi[$ancestor->{'gi'}];
  8432.         $xpath.= "/$gi";
  8433.         my $index= $ancestor->prev_siblings( $gi) + 1;
  8434.         unless( ($index == 1) && !$ancestor->next_sibling( $gi))
  8435.           { $xpath.= "[$index]"; }
  8436.       }
  8437.     return $xpath;
  8438.   }
  8439.  
  8440. # methods used mainly by wrap_children
  8441.  
  8442. # return a string with the 
  8443. # for an element <foo><elt att="val">...</elt><elt2/><elt>...</elt></foo>
  8444. # returns '<elt att="val"><elt2><elt>'
  8445. sub _stringify_struct
  8446.   { my( $elt, %opt)= @_;
  8447.     my $string='';
  8448.     my $pretty_print= set_pretty_print( 'none');
  8449.     foreach my $child ($elt->_children)
  8450.       { $child->add_id; $string .= $child->start_tag( { escape_gt => 1 }) ||''; }
  8451.     set_pretty_print( $pretty_print);
  8452.     return $string;
  8453.   }
  8454.  
  8455. # wrap a series of elements in a new one
  8456. sub _wrap_range
  8457.   { my $elt= shift;
  8458.     my $gi= shift;
  8459.     my $atts= isa( $_[0], 'HASH') ? shift : undef;
  8460.     my $range= shift; # the string with the tags to wrap
  8461.  
  8462.     my $t= $elt->twig;
  8463.  
  8464.     # get the tags to wrap
  8465.     my @to_wrap;
  8466.     while( $range=~ m{<\w+\s+[^>]*id=("[^"]*"|'[^']*')[^>]*>}g)
  8467.       { push @to_wrap, $t->elt_id( substr( $1, 1, -1)); }
  8468.  
  8469.     return '' unless @to_wrap;
  8470.     
  8471.     my $to_wrap= shift @to_wrap;
  8472.     my %atts= %$atts;
  8473.     my $new_elt= $to_wrap->wrap_in( $gi, \%atts);
  8474.     $_->move( last_child => $new_elt) foreach (@to_wrap);
  8475.  
  8476.     return '';
  8477.   }
  8478.     
  8479. # wrap children matching a regexp in a new element
  8480. sub wrap_children
  8481.   { my( $elt, $regexp, $gi, $atts)= @_;
  8482.  
  8483.     $atts ||={};
  8484.  
  8485.     my $elt_as_string= $elt->_stringify_struct; # stringify the elt structure
  8486.     $regexp=~ s{(<[^>]*>)}{_match_expr( $1)}eg; # in the regexp, replace gi's by the proper regexp 
  8487.     $elt_as_string=~ s{($regexp)}{$elt->_wrap_range( $gi, $atts, $1)}eg; # then do the actual replace
  8488.   
  8489.     return $elt; 
  8490.   }
  8491.  
  8492. sub _match_expr
  8493.   { my $tag= shift;
  8494.     my( $gi, %atts)= XML::Twig::_parse_start_tag( $tag);
  8495.     return _match_tag( $gi, %atts);
  8496.   }
  8497.  
  8498.  
  8499. sub _match_tag
  8500.   { my( $elt, %atts)= @_;
  8501.     my $string= "<$elt\\b";
  8502.     foreach my $key (sort keys %atts)
  8503.       { my $val= qq{\Q$atts{$key}\E};
  8504.         $string.= qq{[^>]*$key=(?:"$val"|'$val')};
  8505.       }
  8506.     $string.=  qq{[^>]*>};
  8507.     return "(?:$string)";
  8508.   }
  8509.  
  8510. sub field_to_att
  8511.   { my( $elt, $cond, $att)= @_;
  8512.     $att ||= $cond;
  8513.     my $child= $elt->first_child( $cond) or return undef;
  8514.     $elt->set_att( $att => $child->text);
  8515.     $child->cut;
  8516.     return $elt;
  8517.   }
  8518.  
  8519. sub att_to_field
  8520.   { my( $elt, $att, $tag)= @_;
  8521.     $tag ||= $att;
  8522.     my $child= $elt->insert_new_elt( first_child => $tag, $elt->{'att'}->{$att});
  8523.     $elt->del_att( $att);
  8524.     return $elt;
  8525.   }
  8526.  
  8527. # sort children methods
  8528.  
  8529. sub sort_children_on_field
  8530.   { my $elt   = shift;
  8531.     my $field = shift;
  8532.     my $get_key= sub { return $_[0]->field( $field) };
  8533.     return $elt->sort_children( $get_key, @_); 
  8534.   }
  8535.  
  8536. sub sort_children_on_att
  8537.   { my $elt = shift;
  8538.     my $att = shift;
  8539.     my $get_key= sub { return $_[0]->{'att'}->{$att} };
  8540.     return $elt->sort_children( $get_key, @_); 
  8541.   }
  8542.  
  8543. sub sort_children_on_value
  8544.   { my $elt   = shift;
  8545.     #my $get_key= eval qq{ sub { return \$_[0]->text } };
  8546.     my $get_key= \&text;
  8547.     return $elt->sort_children( $get_key, @_); 
  8548.   }
  8549.  
  8550.  
  8551. sub sort_children
  8552.   { my( $elt, $get_key, %opt)=@_;
  8553.     $opt{order} ||= 'normal';
  8554.     $opt{type}  ||= 'alpha';
  8555.     my( $par_a, $par_b)= ($opt{order} eq 'reverse') ? qw( b a) : qw ( a b) ;
  8556.     my $op= ($opt{type} eq 'numeric') ? '<=>' : 'cmp' ;
  8557.     my @children= $elt->cut_children;
  8558.     if( $opt{type} eq 'numeric')
  8559.       {  @children= map  { $_->[1] }
  8560.                     sort { $a->[0] <=> $b->[0] }
  8561.                     map  { [ $get_key->( $_), $_] } @children;
  8562.       }
  8563.     elsif( $opt{type} eq 'alpha')
  8564.       {  @children= map  { $_->[1] }
  8565.                     sort { $a->[0] cmp $b->[0] }
  8566.                     map  { [ $get_key->( $_), $_] } @children;
  8567.       }
  8568.     else
  8569.       { croak "wrong sort type '$opt{type}', should be either 'alpha' or 'numeric'"; }
  8570.  
  8571.     @children= reverse @children if( $opt{order} eq 'reverse');
  8572.     $elt->set_content( @children);
  8573.   }
  8574.  
  8575.  
  8576. # comparison methods
  8577.  
  8578. sub before
  8579.   { my( $a, $b)=@_;
  8580.     if( $a->cmp( $b) == -1) { return 1; } else { return 0; }
  8581.   }
  8582.  
  8583. sub after
  8584.   { my( $a, $b)=@_;
  8585.     if( $a->cmp( $b) == 1) { return 1; } else { return 0; }
  8586.   }
  8587.  
  8588. sub lt
  8589.   { my( $a, $b)=@_;
  8590.     return 1 if( $a->cmp( $b) == -1);
  8591.     return 0;
  8592.   }
  8593.  
  8594. sub le
  8595.   { my( $a, $b)=@_;
  8596.     return 1 unless( $a->cmp( $b) == 1);
  8597.     return 0;
  8598.   }
  8599.  
  8600. sub gt
  8601.   { my( $a, $b)=@_;
  8602.     return 1 if( $a->cmp( $b) == 1);
  8603.     return 0;
  8604.   }
  8605.  
  8606. sub ge
  8607.   { my( $a, $b)=@_;
  8608.     return 1 unless( $a->cmp( $b) == -1);
  8609.     return 0;
  8610.   }
  8611.  
  8612.  
  8613. sub cmp
  8614.   { my( $a, $b)=@_;
  8615.  
  8616.     # easy cases
  8617.     return  0 if( $a == $b);    
  8618.     return 1 if( $a->in($b)); # a starts after b 
  8619.     return -1 if( $b->in($a)); # a starts before b
  8620.  
  8621.     # ancestors does not include the element itself
  8622.     my @a_pile= ($a, $a->ancestors); 
  8623.     my @b_pile= ($b, $b->ancestors);
  8624.  
  8625.     # the 2 elements are not in the same twig
  8626.     return undef unless( $a_pile[-1] == $b_pile[-1]);
  8627.  
  8628.     # find the first non common ancestors (they are siblings)
  8629.     my $a_anc= pop @a_pile;
  8630.     my $b_anc= pop @b_pile;
  8631.  
  8632.     while( $a_anc == $b_anc) 
  8633.       { $a_anc= pop @a_pile;
  8634.         $b_anc= pop @b_pile;
  8635.       }
  8636.  
  8637.     # from there move left and right and figure out the order
  8638.     my( $a_prev, $a_next, $b_prev, $b_next)= ($a_anc, $a_anc, $b_anc, $b_anc);
  8639.     while()
  8640.       { $a_prev= $a_prev->{prev_sibling} || return( -1);
  8641.         return 1 if( $a_prev == $b_next);
  8642.         $a_next= $a_next->{next_sibling} || return( 1);
  8643.         return -1 if( $a_next == $b_prev);
  8644.         $b_prev= $b_prev->{prev_sibling} || return( 1);
  8645.         return -1 if( $b_prev == $a_next);
  8646.         $b_next= $b_next->{next_sibling} || return( -1);
  8647.         return 1 if( $b_next == $a_prev);
  8648.       }
  8649.   }
  8650.     
  8651. sub _dump
  8652.   { my( $elt, $option)= @_; 
  8653.   
  8654.     my $atts       = defined $option->{atts}       ? $option->{atts}       :  1;
  8655.     my $extra      = defined $option->{extra}      ? $option->{extra}      :  0;
  8656.     my $short_text = defined $option->{short_text} ? $option->{short_text} : 40;
  8657.  
  8658.     my $sp= '| ';
  8659.     my $indent= $sp x $elt->level;
  8660.     my $indent_sp= '  ' x $elt->level;
  8661.     
  8662.     my $dump='';
  8663.     if( $elt->is_elt)
  8664.       { 
  8665.         $dump .= $indent  . '|-' . $XML::Twig::index2gi[$elt->{'gi'}];
  8666.         
  8667.         if( $atts && (my @atts= $elt->att_names) )
  8668.           { $dump .= ' ' . join( ' ', map { qq{$_="} . $elt->{'att'}->{$_} . qq{"} } @atts); }
  8669.  
  8670.         $dump .= "\n";
  8671.         if( $extra) { $dump .= $elt->_dump_extra_data( $indent, $indent_sp, $short_text); }
  8672.         $dump .= join( "", map { $_->_dump( $option) } $elt->_children);
  8673.       }
  8674.     else
  8675.       { 
  8676.         if( (exists $elt->{'pcdata'}))
  8677.           { $dump .= "$indent|-PCDATA:  '"  . _short_text( $elt->{pcdata}, $short_text) . "'\n" }
  8678.         elsif( (exists $elt->{'ent'}))
  8679.           { $dump .= "$indent|-ENTITY:  '" . _short_text( $elt->{ent}, $short_text) . "'\n" }
  8680.         elsif( (exists $elt->{'cdata'}))
  8681.           { $dump .= "$indent|-CDATA:   '" . _short_text( $elt->{cdata}, $short_text) . "'\n" }
  8682.         elsif( (exists $elt->{'comment'}))
  8683.           { $dump .= "$indent|-COMMENT: '" . _short_text( $elt->comment_string, $short_text) . "'\n" }
  8684.         elsif( (exists $elt->{'target'}))
  8685.           { $dump .= "$indent|-PI:      '"      . $elt->{target} . "' - '" . _short_text( $elt->{data}, $short_text) . "'\n" }
  8686.         if( $extra) { $dump .= $elt->_dump_extra_data( $indent, $indent_sp, $short_text); }
  8687.       }
  8688.     return $dump;
  8689.   }
  8690.  
  8691. sub _dump_extra_data
  8692.   { my( $elt, $indent, $indent_sp, $short_text)= @_;
  8693.     my $dump='';
  8694.     if( $elt->extra_data)
  8695.       { my $extra_data = $indent . "|-- (cpi before) '" . _short_text( $elt->extra_data, $short_text) . "'";
  8696.         $extra_data=~ s{\n}{$indent_sp}g;
  8697.         $dump .= $extra_data . "\n";
  8698.       }
  8699.     if( $elt->_extra_data_in_pcdata)
  8700.       { foreach my $data ( @{$elt->_extra_data_in_pcdata})
  8701.           { my $extra_data = $indent . "|-- (cpi offset $data->{offset}) '" . _short_text( $data->{text}, $short_text) . "'";
  8702.             $extra_data=~ s{\n}{$indent_sp}g;
  8703.             $dump .= $extra_data . "\n";
  8704.           }
  8705.       } 
  8706.     if( $elt->_extra_data_before_end_tag)
  8707.       { my $extra_data = $indent . "|-- (cpi end) '" . _short_text( $elt->_extra_data_before_end_tag, $short_text) . "'";
  8708.         $extra_data=~ s{\n}{$indent_sp}g;
  8709.         $dump .= $extra_data . "\n";
  8710.       } 
  8711.     return $dump;
  8712.   }
  8713.  
  8714.  
  8715. sub _short_text
  8716.   { my( $string, $length)= @_;
  8717.     if( !$length || (length( $string) < $length) ) { return $string; }
  8718.     my $l1= (length( $string) -5) /2;
  8719.     my $l2= length( $string) - ($l1 + 5);
  8720.     return substr( $string, 0, $l1) . ' ... ' . substr( $string, -$l2);
  8721.   }
  8722.  
  8723. 1;
  8724.  
  8725. __END__
  8726.  
  8727. =head1 NAME
  8728.  
  8729. XML::Twig - A perl module for processing huge XML documents in tree mode.
  8730.  
  8731. =head1 SYNOPSIS
  8732.  
  8733. Note that this documentation is intended as a reference to the module.
  8734.  
  8735. Complete docs, including a tutorial, examples, an easier to use HTML version,
  8736. a quick reference card and a FAQ are available at http://www.xmltwig.com/xmltwig
  8737.  
  8738. Small documents (loaded in memory as a tree):
  8739.  
  8740.   my $twig=XML::Twig->new();    # create the twig
  8741.   $twig->parsefile( 'doc.xml'); # build it
  8742.   my_process( $twig);           # use twig methods to process it 
  8743.   $twig->print;                 # output the twig
  8744.  
  8745. Huge documents (processed in combined stream/tree mode):
  8746.  
  8747.   # at most one div will be loaded in memory
  8748.   my $twig=XML::Twig->new(   
  8749.     twig_handlers => 
  8750.       { title   => sub { $_->set_tag( 'h2') }, # change title tags to h2
  8751.         para    => sub { $_->set_tag( 'p')  }, # change para to p
  8752.         hidden  => sub { $_->delete;       },  # remove hidden elements
  8753.         list    => \&my_list_process,          # process list elements
  8754.         div     => sub { $_[0]->flush;     },  # output and free memory
  8755.       },
  8756.     pretty_print => 'indented',                # output will be nicely formatted
  8757.     empty_tags   => 'html',                    # outputs <empty_tag />
  8758.                          );
  8759.     $twig->flush;                              # flush the end of the document
  8760.  
  8761. See L<XML::Twig 101|XML::Twig 101> for other ways to use the module, as a 
  8762. filter for example
  8763.  
  8764.  
  8765. =head1 DESCRIPTION
  8766.  
  8767. This module provides a way to process XML documents. It is build on top
  8768. of C<XML::Parser>.
  8769.  
  8770. The module offers a tree interface to the document, while allowing you
  8771. to output the parts of it that have been completely processed.
  8772.  
  8773. It allows minimal resource (CPU and memory) usage by building the tree
  8774. only for the parts of the documents that need actual processing, through the 
  8775. use of the C<L<twig_roots|twig_roots> > and 
  8776. C<L<twig_print_outside_roots|twig_print_outside_roots> > options. The 
  8777. C<L<finish|finish> > and C<L<finish_print|finish_print> > methods also help 
  8778. to increase performances.
  8779.  
  8780. XML::Twig tries to make simple things easy so it tries its best to takes care 
  8781. of a lot of the (usually) annoying (but sometimes necessary) features that 
  8782. come with XML and XML::Parser.
  8783.  
  8784. =head1 XML::Twig 101
  8785.  
  8786. XML::Twig can be used either on "small" XML documents (that fit in memory)
  8787. or on huge ones, by processing parts of the document and outputting or
  8788. discarding them once they are processed.
  8789.  
  8790.  
  8791. =head2 Loading an XML document and processing it
  8792.  
  8793.   my $t= XML::Twig->new();
  8794.   $t->parse( '<d><title>title</title><para>p 1</para><para>p 2</para></d>');
  8795.   my $root= $t->root;
  8796.   $root->set_tag( 'html');              # change doc to html
  8797.   $title= $root->first_child( 'title'); # get the title
  8798.   $title->set_tag( 'h1');               # turn it into h1
  8799.   my @para= $root->children( 'para');   # get the para children
  8800.   foreach my $para (@para)
  8801.     { $para->set_tag( 'p'); }           # turn them into p
  8802.   $t->print;                            # output the document
  8803.  
  8804. Other useful methods include:
  8805.  
  8806. L<att|att>: C<< $elt->{'att'}->{'foo'} >> return the C<foo> attribute for an 
  8807. element,
  8808.  
  8809. L<set_att|set_att> : C<< $elt->set_att( foo => "bar") >> sets the C<foo> 
  8810. attribute to the C<bar> value,
  8811.  
  8812. L<next_sibling|next_sibling>: C<< $elt->{next_sibling} >> return the next sibling
  8813. in the document (in the example C<< $title->{next_sibling} >> is the first
  8814. C<para>, you can also (and actually should) use 
  8815. C<< $elt->next_sibling( 'para') >> to get it 
  8816.  
  8817. The document can also be transformed through the use of the L<cut|cut>, 
  8818. L<copy|copy>, L<paste|paste> and L<move|move> methods: 
  8819. C<< $title->cut; $title->paste( after => $p); >> for example
  8820.  
  8821. And much, much more, see L<Elt|"Elt">.
  8822.  
  8823. =head2 Processing an XML document chunk by chunk
  8824.  
  8825. One of the strengths of XML::Twig is that it let you work with files that do 
  8826. not fit in memory (BTW storing an XML document in memory as a tree is quite
  8827. memory-expensive, the expansion factor being often around 10).
  8828.  
  8829. To do this you can define handlers, that will be called once a specific 
  8830. element has been completely parsed. In these handlers you can access the
  8831. element and process it as you see fit, using the navigation and the
  8832. cut-n-paste methods, plus lots of convenient ones like C<L<prefix|prefix> >.
  8833. Once the element is completely processed you can then C<L<flush|flush> > it, 
  8834. which will output it and free the memory. You can also C<L<purge|purge> > it 
  8835. if you don't need to output it (if you are just extracting some data from 
  8836. the document for example). The handler will be called again once the next 
  8837. relevant element has been parsed.
  8838.  
  8839.   my $t= XML::Twig->new( twig_handlers => 
  8840.                           { section => \§ion,
  8841.                             para   => sub { $_->set_tag( 'p');
  8842.                           },
  8843.                        );
  8844.   $t->parsefile( 'doc.xml');
  8845.   $t->flush; # don't forget to flush one last time in the end or anything
  8846.              # after the last </section> tag will not be output 
  8847.     
  8848.   # the handler is called once a section is completely parsed, ie when 
  8849.   # the end tag for section is found, it receives the twig itself and
  8850.   # the element (including all its sub-elements) as arguments
  8851.   sub section 
  8852.     { my( $t, $section)= @_;      # arguments for all twig_handlers
  8853.       $section->set_tag( 'div');  # change the tag name.4, my favourite method...
  8854.       # let's use the attribute nb as a prefix to the title
  8855.       my $title= $section->first_child( 'title'); # find the title
  8856.       my $nb= $title->{'att'}->{'nb'}; # get the attribute
  8857.       $title->prefix( "$nb - ");  # easy isn't it?
  8858.       $section->flush;            # outputs the section and frees memory
  8859.     }
  8860.  
  8861.         
  8862. There is of course more to it: you can trigger handlers on more elaborate 
  8863. conditions than just the name of the element, C<section/title> for example.
  8864.  
  8865.   my $t= XML::Twig->new( twig_handlers => 
  8866.                            { 'section/title' => sub { $_->print } }
  8867.                        )
  8868.                   ->parsefile( 'doc.xml');
  8869.  
  8870. Here C<< sub { $_->print } >> simply prints the current element (C<$_> is aliased
  8871. to the element in the handler).
  8872.  
  8873. You can also trigger a handler on a test on an attribute:
  8874.  
  8875.   my $t= XML::Twig->new( twig_handlers => 
  8876.                       { 'section[@level="1"]' => sub { $_->print } }
  8877.                        );
  8878.                   ->parsefile( 'doc.xml');
  8879.  
  8880. You can also use C<L<start_tag_handlers|start_tag_handlers> > to process an 
  8881. element as soon as the start tag is found. Besides C<L<prefix|prefix> > you
  8882. can also use C<L<suffix|suffix> >, 
  8883.  
  8884. =head2 Processing just parts of an XML document
  8885.  
  8886. The twig_roots mode builds only the required sub-trees from the document
  8887. Anything outside of the twig roots will just be ignored:
  8888.  
  8889.   my $t= XML::Twig->new( 
  8890.        # the twig will include just the root and selected titles 
  8891.            twig_roots   => { 'section/title' => \&print_n_purge,
  8892.                              'annex/title'   => \&print_n_purge
  8893.            }
  8894.                       );
  8895.   $t->parsefile( 'doc.xml');
  8896.   
  8897.   sub print_n_purge 
  8898.     { my( $t, $elt)= @_;
  8899.       print $elt->text;    # print the text (including sub-element texts)
  8900.       $t->purge;           # frees the memory
  8901.     }
  8902.  
  8903. You can use that mode when you want to process parts of a documents but are
  8904. not interested in the rest and you don't want to pay the price, either in
  8905. time or memory, to build the tree for the it.
  8906.  
  8907.  
  8908. =head2 Building an XML filter
  8909.  
  8910. You can combine the C<twig_roots> and the C<twig_print_outside_roots> options to 
  8911. build filters, which let you modify selected elements and will output the rest 
  8912. of the document as is.
  8913.  
  8914. This would convert prices in $ to prices in Euro in a document:
  8915.  
  8916.   my $t= XML::Twig->new( 
  8917.            twig_roots   => { 'price' => \&convert, },   # process prices 
  8918.            twig_print_outside_roots => 1,               # print the rest
  8919.                       );
  8920.   $t->parsefile( 'doc.xml');
  8921.  
  8922.   sub convert 
  8923.     { my( $t, $price)= @_;
  8924.       my $currency=  $price->{'att'}->{'currency'};          # get the currency
  8925.       if( $currency eq 'USD')
  8926.         { $usd_price= $price->text;                     # get the price
  8927.           # %rate is just a conversion table 
  8928.           my $euro_price= $usd_price * $rate{usd2euro};
  8929.           $price->set_text( $euro_price);               # set the new price
  8930.           $price->set_att( currency => 'EUR');          # don't forget this!
  8931.         }
  8932.       $price->print;                                    # output the price
  8933.     }
  8934.  
  8935. =head2 XML::Twig and various versions of Perl, XML::Parser and expat:
  8936.  
  8937. Before being uploaded to CPAN, XML::Twig 3.22 has been tested under the 
  8938. following environments:
  8939.  
  8940. =over 4
  8941.  
  8942. =item linux-x86
  8943.  
  8944. perl 5.6.2, expat 1.95.8, XML::Parser 2.34
  8945. perl 5.8.0, expat 1.95.8, XML::Parser 2.34
  8946. perl 5.8.7, expat 1.95.8, XML::Parser2.34
  8947.  
  8948. =item Solaris
  8949.  
  8950. perl 5.6.1, expat 1.95.2, XML::Parser 2.31
  8951.  
  8952. =back
  8953.  
  8954. XML::Twig is a lot more sensitive to variations in versions of perl, 
  8955. XML::Parser and expat than to the OS, so this should cover some
  8956. reasonable configurations.
  8957.  
  8958. The "recommended configuration" is perl 5.8.3+ (for good Unicode
  8959. support), XML::Parser 2.31+ and expat 1.95.5+
  8960.  
  8961. See L<http://testers.cpan.org/search?request=dist&dist=XML-Twig> for the
  8962. CPAN testers reports on XML::Twig, which list all tested configurations.
  8963.  
  8964. An Atom feed of the CPAN Testers results is available at
  8965. L<http://xmltwig.com/rss/twig_testers.rss>
  8966.  
  8967. Finally: 
  8968.  
  8969. =over 4
  8970.  
  8971. =item XML::Twig does B<NOT> work with expat 1.95.4
  8972.   
  8973. =item  XML::Twig only works with XML::Parser 2.27 in perl 5.6.*  
  8974.  
  8975. Note that I can't compile XML::Parser 2.27 anymore, so I can't guarantee 
  8976. that it still works
  8977.  
  8978. =item XML::Parser 2.28 does not really work
  8979.  
  8980. =back
  8981.  
  8982. When in doubt, upgrade expat, XML::Parser and Scalar::Util
  8983.  
  8984. Finally, for some optional features, XML::Twig depends on some additional
  8985. modules. The complete list, which depends somewhat on the version of Perl
  8986. that you are running, is given by running C<t/zz_dump_config.t>
  8987.  
  8988. =head1 Simplifying XML processing
  8989.  
  8990. =over 4
  8991.  
  8992. =item Whitespaces
  8993.  
  8994. Whitespaces that look non-significant are discarded, this behaviour can be 
  8995. controlled using the C<L<keep_spaces|keep_spaces> >, 
  8996. C<L<keep_spaces_in|keep_spaces_in> > and 
  8997. C<L<discard_spaces_in|discard_spaces_in> > options.
  8998.  
  8999. =item Encoding
  9000.  
  9001. You can specify that you want the output in the same encoding as the input
  9002. (provided you have valid XML, which means you have to specify the encoding
  9003. either in the document or when you create the Twig object) using the 
  9004. C<L<keep_encoding|keep_encoding> > option
  9005.  
  9006. You can also use C<L<output_encoding>> to convert the internal UTF-8 format
  9007. to the required encoding.
  9008.  
  9009. =item Comments and Processing Instructions (PI)
  9010.  
  9011. Comments and PI's can be hidden from the processing, but still appear in the
  9012. output (they are carried by the "real" element closer to them)
  9013.  
  9014. =item Pretty Printing
  9015.  
  9016. XML::Twig can output the document pretty printed so it is easier to read for
  9017. us humans.
  9018.  
  9019. =item Surviving an untimely death
  9020.  
  9021. XML parsers are supposed to react violently when fed improper XML. 
  9022. XML::Parser just dies.
  9023.  
  9024. XML::Twig provides the C<L<safe_parse|safe_parse> > and the 
  9025. C<L<safe_parsefile|safe_parsefile> > methods which wrap the parse in an eval
  9026. and return either the parsed twig or 0 in case of failure.
  9027.  
  9028. =item Private attributes
  9029.  
  9030. Attributes with a name starting with # (illegal in XML) will not be
  9031. output, so you can safely use them to store temporary values during
  9032. processing. Note that you can store anything in a private attribute, 
  9033. not just text, it's just a regular Perl variable, so a reference to
  9034. an object or a huge data structure is perfectly fine.
  9035.  
  9036. =back
  9037.  
  9038. =head1 CLASSES
  9039.  
  9040. XML::Twig uses a very limited number of classes. The ones you are most likely to use
  9041. are C<L<XML::Twig>> of course, which represents a complete XML document, including the 
  9042. document itself (the root of the document itself is C<L<root>>), its handlers, its
  9043. input or output filters... The other main class is C<L<XML::Twig::Elt>>, which models 
  9044. an XML element. Element here has a very wide definition: it can be a regular element, or
  9045. but also text, with an element C<L<tag>> of C<#PCDATA> (or C<#CDATA>), an entity (tag is
  9046. C<#ENT>), a Processing Instruction (C<#PI>), a comment (C<#COMMENT>). 
  9047.  
  9048. Those are the 2 commonly used classes.
  9049.  
  9050. You might want to look the C<L<elt_class>> option if you want to subclass C<XML::Twig::Elt>.
  9051.  
  9052. Attributes are just attached to their parent element, they are not objects per se. (Please
  9053. use the provided methods C<L<att>> and C<L<set_att>> to access them, if you access them
  9054. as a hash, then your code becomes implementaion dependent and might break in the future).
  9055.  
  9056. Other classes that are seldom used are C<L<XML::Twig::Entity_list>> and C<L<XML::Twig::Entity>>.
  9057.  
  9058. If you use C<L<XML::Twig::XPath>> instead of C<XML::Twig>, elements are then created as
  9059. C<L<XML::Twig::XPath::Elt>>
  9060.  
  9061.  
  9062. =head1 METHODS
  9063.  
  9064. =head2 XML::Twig 
  9065.  
  9066. A twig is a subclass of XML::Parser, so all XML::Parser methods can be
  9067. called on a twig object, including parse and parsefile.
  9068. C<setHandlers> on the other hand cannot be used, see C<L<BUGS|BUGS> >
  9069.  
  9070.  
  9071. =over 4
  9072.  
  9073. =item new 
  9074.  
  9075. This is a class method, the constructor for XML::Twig. Options are passed
  9076. as keyword value pairs. Recognized options are the same as XML::Parser,
  9077. plus some XML::Twig specifics.
  9078.  
  9079. New Options:
  9080.  
  9081. =over 4
  9082.  
  9083. =item twig_handlers
  9084.  
  9085. This argument consists of a hash C<{ expression => \&handler}> where 
  9086. expression is a an I<XPath-like expression> (+ some others). 
  9087.  
  9088. XPath expressions are limited to using the child and descendant axis
  9089. (indeed you can't specify an axis), and predicates cannot be nested.
  9090. You can use the C<string>, or C<< string(<tag>) >> function (except 
  9091. in C<twig_roots> triggers).
  9092.  
  9093. Additionally you can use regexps (/ delimited) to match attribute
  9094. and string values.
  9095.  
  9096. Examples:
  9097.  
  9098.   foo
  9099.   foo/bar
  9100.   foo//bar
  9101.   /foo/bar
  9102.   /foo//bar
  9103.   /foo/bar[@att1 = "val1" and @att2 = "val2"]/baz[@a >= 1]
  9104.   foo[string()=~ /^duh!+/]
  9105.   /foo[string(bar)=~ /\d+/]/baz[@att != 3]
  9106.  
  9107. #CDATA can be used to call a handler for a CDATA.
  9108. #COMMENT can be used to call a handler for comments
  9109.  
  9110. Some additional (non-XPath) expressions are also provided for convenience: 
  9111.  
  9112. =over 4
  9113.  
  9114. =item processing instructions
  9115.  
  9116. C<'?'> or C<'#PI'> triggers the handler for any processing instruction,
  9117. and C<< '?<target>' >> or C<< '#PI <target>' >> triggers a handler for processing
  9118. instruction with the given target( ex: C<'#PI xml-stylesheet'>).
  9119.  
  9120. =item level(<level>)
  9121.  
  9122. Triggers the handler on any element at that level in the tree (root is level 1)
  9123.  
  9124. =item _all_
  9125.  
  9126. Triggers the handler for B<all> elements in the tree
  9127.  
  9128. =item _default_
  9129.  
  9130. Triggers the handler for each element that does NOT have any other handler.
  9131.  
  9132. =back
  9133.  
  9134. Expressions are evaluated against the input document. 
  9135. Which means that even if you have changed the tag of an element (changing the
  9136. tag of a parent element from a handler for example) the change will not impact
  9137. the expression evaluation. There is an exception to this: "private" attributes
  9138. (which name start with a '#', and can only be created during the parsing, as
  9139. they are not valid XML) are checked against the current twig. 
  9140.  
  9141. Handlers are triggered in fixed order, sorted by their type (xpath expressions
  9142. first, then regexps, then level), then by whether they specify a full path 
  9143. (starting at the root element) or
  9144. not, then by by number of steps in the expression , then number of
  9145. predicates, then number of tests in predicates. Handlers where the last
  9146. step does not specify a step (C<foo/bar/*>) are triggered after other XPath handlers.
  9147. Finally C<_all_> handlers are triggered last. 
  9148.  
  9149. B<Important>: once a handler has been triggered if it returns 0 then no other
  9150. handler is called, except a C<_all_> handler which will be called anyway.
  9151.  
  9152. If a handler returns a true value and other handlers apply, then the next
  9153. applicable handler will be called. Repeat, rinse, lather..; The exception
  9154. to that rule is when the C<L<do_not_chain_handlers|do_not_chain_handlers>>
  9155. option is set, in which case only the first handler will be called.
  9156.  
  9157. Note that it might be a good idea to explicitly return a short true value
  9158. (like 1) from handlers: this ensures that other applicable handlers are 
  9159. called even if the last statement for the handler happens to evaluate to
  9160. false. This might also speedup the code by avoiding the result of the last 
  9161. statement of the code to be copied and passed to the code managing handlers.
  9162. It can really pay to have 1 instead of a long string returned.
  9163.  
  9164. When an element is CLOSED the corresponding handler is called, with 2
  9165. arguments: the twig and the C<L</Element|/Element> >. The twig includes the 
  9166. document tree that has been built so far, the element is the complete sub-tree
  9167. for the element. This means that handlers for inner elements are called before
  9168. handlers for outer elements.
  9169.  
  9170. C<$_> is also set to the element, so it is easy to write inline handlers like
  9171.  
  9172.   para => sub { $_->set_tag( 'p'); }
  9173.  
  9174. Text is stored in elements whose tag is #PCDATA (due to mixed content, text
  9175. and sub-element in an element there is no way to store the text as just an
  9176. attribute of the enclosing element).
  9177.  
  9178. B<Warning>: if you have used purge or flush on the twig the element might not
  9179. be complete, some of its children might have been entirely flushed or purged,
  9180. and the start tag might even have been printed (by C<flush>) already, so changing
  9181. its tag might not give the expected result.
  9182.  
  9183.  
  9184. =item twig_roots
  9185.  
  9186. This argument let's you build the tree only for those elements you are
  9187. interested in. 
  9188.  
  9189.   Example: my $t= XML::Twig->new( twig_roots => { title => 1, subtitle => 1});
  9190.            $t->parsefile( file);
  9191.            my $t= XML::Twig->new( twig_roots => { 'section/title' => 1});
  9192.            $t->parsefile( file);
  9193.  
  9194.  
  9195. return a twig containing a document including only C<title> and C<subtitle> 
  9196. elements, as children of the root element.
  9197.  
  9198. You can use I<generic_attribute_condition>, I<attribute_condition>,
  9199. I<full_path>, I<partial_path>, I<tag>, I<tag_regexp>, I<_default_> and 
  9200. I<_all_> to trigger the building of the twig. 
  9201. I<string_condition> and I<regexp_condition> cannot be used as the content 
  9202. of the element, and the string, have not yet been parsed when the condition
  9203. is checked.
  9204.  
  9205. B<WARNING>: path are checked for the document. Even if the C<twig_roots> option
  9206. is used they will be checked against the full document tree, not the virtual
  9207. tree created by XML::Twig
  9208.  
  9209.  
  9210. B<WARNING>: twig_roots elements should NOT be nested, that would hopelessly
  9211. confuse XML::Twig ;--(
  9212.  
  9213. Note: you can set handlers (twig_handlers) using twig_roots
  9214.   Example: my $t= XML::Twig->new( twig_roots => 
  9215.                                    { title    => sub { $_{1]->print;}, 
  9216.                                      subtitle => \&process_subtitle 
  9217.                                    }
  9218.                                );
  9219.            $t->parsefile( file);
  9220.  
  9221.  
  9222. =item twig_print_outside_roots
  9223.  
  9224. To be used in conjunction with the C<twig_roots> argument. When set to a true 
  9225. value this will print the document outside of the C<twig_roots> elements.
  9226.  
  9227.  Example: my $t= XML::Twig->new( twig_roots => { title => \&number_title },
  9228.                                 twig_print_outside_roots => 1,
  9229.                                );
  9230.            $t->parsefile( file);
  9231.            { my $nb;
  9232.            sub number_title
  9233.              { my( $twig, $title);
  9234.                $nb++;
  9235.                $title->prefix( "$nb "; }
  9236.                $title->print;
  9237.              }
  9238.            }
  9239.                
  9240.  
  9241. This example prints the document outside of the title element, calls 
  9242. C<number_title> for each C<title> element, prints it, and then resumes printing
  9243. the document. The twig is built only for the C<title> elements. 
  9244.  
  9245. If the value is a reference to a file handle then the document outside the
  9246. C<twig_roots> elements will be output to this file handle:
  9247.  
  9248.   open( OUT, ">out_file") or die "cannot open out file out_file:$!";
  9249.   my $t= XML::Twig->new( twig_roots => { title => \&number_title },
  9250.                          # default output to OUT
  9251.                          twig_print_outside_roots => \*OUT, 
  9252.                        );
  9253.  
  9254.          { my $nb;
  9255.            sub number_title
  9256.              { my( $twig, $title);
  9257.                $nb++;
  9258.                $title->prefix( "$nb "; }
  9259.                $title->print( \*OUT);    # you have to print to \*OUT here
  9260.              }
  9261.            }
  9262.  
  9263.  
  9264. =item start_tag_handlers
  9265.  
  9266. A hash C<{ expression => \&handler}>. Sets element handlers that are called when
  9267. the element is open (at the end of the XML::Parser C<Start> handler). The handlers
  9268. are called with 2 params: the twig and the element. The element is empty at 
  9269. that point, its attributes are created though. 
  9270.  
  9271. You can use I<generic_attribute_condition>, I<attribute_condition>,
  9272. I<full_path>, I<partial_path>, I<tag>, I<tag_regexp>, I<_default_>  and I<_all_> 
  9273. to trigger the handler. 
  9274.  
  9275. I<string_condition> and I<regexp_condition> cannot be used as the content of 
  9276. the element, and the string, have not yet been parsed when the condition is 
  9277. checked.
  9278.  
  9279. The main uses for those handlers are to change the tag name (you might have to 
  9280. do it as soon as you find the open tag if you plan to C<flush> the twig at some
  9281. point in the element, and to create temporary attributes that will be used
  9282. when processing sub-element with C<twig_hanlders>. 
  9283.  
  9284. You should also use it to change tags if you use C<flush>. If you change the tag 
  9285. in a regular C<twig_handler> then the start tag might already have been flushed. 
  9286.  
  9287. B<Note>: C<start_tag> handlers can be called outside of C<twig_roots> if this 
  9288. argument is used, in this case handlers are called with the following arguments:
  9289. C<$t> (the twig), C<$tag> (the tag of the element) and C<%att> (a hash of the 
  9290. attributes of the element). 
  9291.  
  9292. If the C<twig_print_outside_roots> argument is also used, if the last handler
  9293. called returns  a C<true> value, then the the start tag will be output as it
  9294. appeared in the original document, if the handler returns a a C<false> value
  9295. then the start tag will B<not> be printed (so you can print a modified string 
  9296. yourself for example).
  9297.  
  9298. Note that you can use the L<ignore|ignore> method in C<start_tag_handlers> 
  9299. (and only there). 
  9300.  
  9301. =item end_tag_handlers
  9302.  
  9303. A hash C<{ expression => \&handler}>. Sets element handlers that are called when
  9304. the element is closed (at the end of the XML::Parser C<End> handler). The handlers
  9305. are called with 2 params: the twig and the tag of the element. 
  9306.  
  9307. I<twig_handlers> are called when an element is completely parsed, so why have 
  9308. this redundant option? There is only one use for C<end_tag_handlers>: when using
  9309. the C<twig_roots> option, to trigger a handler for an element B<outside> the roots.
  9310. It is for example very useful to number titles in a document using nested 
  9311. sections: 
  9312.  
  9313.   my @no= (0);
  9314.   my $no;
  9315.   my $t= XML::Twig->new( 
  9316.           start_tag_handlers => 
  9317.            { section => sub { $no[$#no]++; $no= join '.', @no; push @no, 0; } },
  9318.           twig_roots         => 
  9319.            { title   => sub { $_[1]->prefix( $no); $_[1]->print; } },
  9320.           end_tag_handlers   => { section => sub { pop @no;  } },
  9321.           twig_print_outside_roots => 1
  9322.                       );
  9323.    $t->parsefile( $file);
  9324.  
  9325. Using the C<end_tag_handlers> argument without C<twig_roots> will result in an
  9326. error.
  9327.  
  9328. =item do_not_chain_handlers
  9329.  
  9330. If this option is set to a true value, then only one handler will be called for
  9331. each element, even if several satisfy the condition
  9332.  
  9333. Note that the C<_all_> handler will still be called regardless
  9334.  
  9335. =item ignore_elts
  9336.  
  9337. This option lets you ignore elements when building the twig. This is useful 
  9338. in cases where you cannot use C<twig_roots> to ignore elements, for example if
  9339. the element to ignore is a sibling of elements you are interested in.
  9340.  
  9341. Example:
  9342.  
  9343.   my $twig= XML::Twig->new( ignore_elts => { elt => 1 });
  9344.   $twig->parsefile( 'doc.xml');
  9345.  
  9346. This will build the complete twig for the document, except that all C<elt> 
  9347. elements (and their children) will be left out.
  9348.  
  9349.  
  9350. =item char_handler
  9351.  
  9352. A reference to a subroutine that will be called every time C<PCDATA> is found.
  9353.  
  9354. The subroutine receives the string as argument, and returns the modified string:
  9355.  
  9356.   # we want all strings in upper case
  9357.   sub my_char_handler
  9358.     { my( $text)= @_;
  9359.       $text= uc( $text);
  9360.       return $text;
  9361.     }
  9362.  
  9363. =item elt_class
  9364.  
  9365. The name of a class used to store elements. this class should inherit from
  9366. C<XML::Twig::Elt> (and by default it is C<XML::Twig::Elt>). This option is used
  9367. to subclass the element class and extend it with new methods.
  9368.  
  9369. This option is needed because during the parsing of the XML, elements are created
  9370. by C<XML::Twig>, without any control from the user code.
  9371.  
  9372. =item keep_atts_order
  9373.  
  9374. Setting this option to a true value causes the attribute hash to be tied to
  9375. a C<Tie::IxHash> object.
  9376. This means that C<Tie::IxHash> needs to be installed for this option to be 
  9377. available. It also means that the hash keeps its order, so you will get 
  9378. the attributes in order. This allows outputting the attributes in the same 
  9379. order as they were in the original document.
  9380.  
  9381. =item keep_encoding
  9382.  
  9383. This is a (slightly?) evil option: if the XML document is not UTF-8 encoded and
  9384. you want to keep it that way, then setting keep_encoding will use theC<Expat> 
  9385. original_string method for character, thus keeping the original encoding, as 
  9386. well as the original entities in the strings.
  9387.  
  9388. See the C<t/test6.t> test file to see what results you can expect from the 
  9389. various encoding options.
  9390.  
  9391. B<WARNING>: if the original encoding is multi-byte then attribute parsing will
  9392. be EXTREMELY unsafe under any Perl before 5.6, as it uses regular expressions
  9393. which do not deal properly with multi-byte characters. You can specify an 
  9394. alternate function to parse the start tags with the C<parse_start_tag> option 
  9395. (see below)
  9396.  
  9397. B<WARNING>: this option is NOT used when parsing with the non-blocking parser 
  9398. (C<parse_start>, C<parse_more>, parse_done methods) which you probably should 
  9399. not use with XML::Twig anyway as they are totally untested!
  9400.  
  9401. =item output_encoding
  9402.  
  9403. This option generates an output_filter using C<Encode>,  C<Text::Iconv> or 
  9404. C<Unicode::Map8> and C<Unicode::Strings>, and sets the encoding in the XML
  9405. declaration. This is the easiest way to deal with encodings, if you need 
  9406. more sophisticated features, look at C<output_filter> below
  9407.  
  9408.  
  9409. =item output_filter
  9410.  
  9411. This option is used to convert the character encoding of the output document.
  9412. It is passed either a string corresponding to a predefined filter or
  9413. a subroutine reference. The filter will be called every time a document or 
  9414. element is processed by the "print" functions (C<print>, C<sprint>, C<flush>). 
  9415.  
  9416. Pre-defined filters: 
  9417.  
  9418. =over 4 
  9419.  
  9420. =item latin1 
  9421.  
  9422. uses either C<Encode>, C<Text::Iconv> or C<Unicode::Map8> and C<Unicode::String>
  9423. or a regexp (which works only with XML::Parser 2.27), in this order, to convert 
  9424. all characters to ISO-8859-1 (aka latin1)
  9425.  
  9426. =item html
  9427.  
  9428. does the same conversion as C<latin1>, plus encodes entities using
  9429. C<HTML::Entities> (oddly enough you will need to have HTML::Entities installed 
  9430. for it to be available). This should only be used if the tags and attribute 
  9431. names themselves are in US-ASCII, or they will be converted and the output will
  9432. not be valid XML any more
  9433.  
  9434. =item safe
  9435.  
  9436. converts the output to ASCII (US) only  plus I<character entities> (C<&#nnn;>) 
  9437. this should be used only if the tags and attribute names themselves are in 
  9438. US-ASCII, or they will be converted and the output will not be valid XML any 
  9439. more
  9440.  
  9441. =item safe_hex
  9442.  
  9443. same as C<safe> except that the character entities are in hexa (C<&#xnnn;>)
  9444.  
  9445. =item encode_convert ($encoding)
  9446.  
  9447. Return a subref that can be used to convert utf8 strings to C<$encoding>).
  9448. Uses C<Encode>.
  9449.  
  9450.    my $conv = XML::Twig::encode_convert( 'latin1');
  9451.    my $t = XML::Twig->new(output_filter => $conv);
  9452.  
  9453. =item iconv_convert ($encoding)
  9454.  
  9455. this function is used to create a filter subroutine that will be used to 
  9456. convert the characters to the target encoding using C<Text::Iconv> (which needs
  9457. to be installed, look at the documentation for the module and for the
  9458. C<iconv> library to find out which encodings are available on your system)
  9459.  
  9460.    my $conv = XML::Twig::iconv_convert( 'latin1');
  9461.    my $t = XML::Twig->new(output_filter => $conv);
  9462.  
  9463. =item unicode_convert ($encoding)
  9464.  
  9465. this function is used to create a filter subroutine that will be used to 
  9466. convert the characters to the target encoding using  C<Unicode::Strings> 
  9467. and C<Unicode::Map8> (which need to be installed, look at the documentation 
  9468. for the modules to find out which encodings are available on your system)
  9469.  
  9470.    my $conv = XML::Twig::unicode_convert( 'latin1');
  9471.    my $t = XML::Twig->new(output_filter => $conv);
  9472.  
  9473. =back
  9474.  
  9475. The C<text> and C<att> methods do not use the filter, so their 
  9476. result are always in unicode.
  9477.  
  9478. Those predeclared filters are based on subroutines that can be used
  9479. by themselves (as C<XML::Twig::foo>). 
  9480.  
  9481. =over 4
  9482.  
  9483. =item html_encode ($string)
  9484.  
  9485. Use C<HTML::Entities> to encode a utf8 string
  9486.  
  9487. =item safe_encode ($string)
  9488.  
  9489. Use either a regexp (perl < 5.8) or C<Encode> to encode non-ascii characters
  9490. in the string in C<< &#<nnnn>; >> format
  9491.  
  9492. =item safe_encode_hex ($string)
  9493.  
  9494. Use either a regexp (perl < 5.8) or C<Encode> to encode non-ascii characters
  9495. in the string in C<< &#x<nnnn>; >> format
  9496.  
  9497. =item regexp2latin1 ($string)
  9498.  
  9499. Use a regexp to encode a utf8 string into latin 1 (ISO-8859-1). Does not
  9500. work with Perl 5.8.0!
  9501.  
  9502. =back
  9503.  
  9504. =item output_text_filter
  9505.  
  9506. same as output_filter, except it doesn't apply to the brackets and quotes 
  9507. around attribute values. This is useful for all filters that could change
  9508. the tagging, basically anything that does not just change the encoding of
  9509. the output. C<html>, C<safe> and C<safe_hex> are better used with this option.
  9510.  
  9511. =item input_filter
  9512.  
  9513. This option is similar to C<output_filter> except the filter is applied to 
  9514. the characters before they are stored in the twig, at parsing time.
  9515.  
  9516. =item remove_cdata
  9517.  
  9518. Setting this option to a true value will force the twig to output CDATA 
  9519. sections as regular (escaped) PCDATA
  9520.  
  9521. =item parse_start_tag
  9522.  
  9523. If you use the C<keep_encoding> option then this option can be used to replace
  9524. the default parsing function. You should provide a coderef (a reference to a 
  9525. subroutine) as the argument, this subroutine takes the original tag (given
  9526. by XML::Parser::Expat C<original_string()> method) and returns a tag and the
  9527. attributes in a hash (or in a list attribute_name/attribute value).
  9528.  
  9529. =item expand_external_ents
  9530.  
  9531. When this option is used external entities (that are defined) are expanded
  9532. when the document is output using "print" functions such as C<L<print> >,
  9533. C<L<sprint|sprint> >, C<L<flush|flush> > and C<L<xml_string|xml_string> >. 
  9534. Note that in the twig the entity will be stored as an element with a 
  9535. tag 'C<#ENT>', the entity will not be expanded there, so you might want to 
  9536. process the entities before outputting it.
  9537.  
  9538. If an external entity is not available, then the parse will fail.
  9539.  
  9540. A special case is when the value of this option is -1. In that case a missing
  9541. entity will not cause the parser to die, but its C<name>, C<sysid> and C<pubid>
  9542. will be stored in the twig as C<< $twig->{twig_missing_system_entities} >>
  9543. (a reference to an array of hashes { name => <name>, sysid => <sysid>,
  9544. pubid => <pubid> }). Yes, this is a bit of a hack, but it's useful in some
  9545. cases.  
  9546.  
  9547. =item load_DTD
  9548.  
  9549. If this argument is set to a true value, C<parse> or C<parsefile> on the twig
  9550. will load  the DTD information. This information can then be accessed through 
  9551. the twig, in a C<DTD_handler> for example. This will load even an external DTD.
  9552.  
  9553. Default and fixed values for attributes will also be filled, based on the DTD.
  9554.  
  9555. Note that to do this the module will generate a temporary file in the current
  9556. directory. If this is a problem let me know and I will add an option to
  9557. specify an alternate directory.
  9558.  
  9559. See L<DTD Handling|DTD Handling> for more information
  9560.  
  9561. =item DTD_handler
  9562.  
  9563. Set a handler that will be called once the doctype (and the DTD) have been 
  9564. loaded, with 2 arguments, the twig and the DTD.
  9565.  
  9566. =item no_prolog
  9567.  
  9568. Does not output a prolog (XML declaration and DTD)
  9569.  
  9570. =item id
  9571.  
  9572. This optional argument gives the name of an attribute that can be used as
  9573. an ID in the document. Elements whose ID is known can be accessed through
  9574. the elt_id method. id defaults to 'id'.
  9575. See C<L<BUGS|BUGS> >
  9576.  
  9577. =item discard_spaces
  9578.  
  9579. If this optional argument is set to a true value then spaces are discarded
  9580. when they look non-significant: strings containing only spaces are discarded.
  9581. This argument is set to true by default.
  9582.  
  9583. =item keep_spaces
  9584.  
  9585. If this optional argument is set to a true value then all spaces in the
  9586. document are kept, and stored as C<PCDATA>.
  9587.  
  9588. B<Warning>: adding this option can result in changes in the twig generated:
  9589. space that was previously discarded might end up in a new text element. see
  9590. the difference by calling the following code with 0 and 1 as arguments:
  9591.  
  9592.   perl -MXML::Twig -e'print XML::Twig->new( keep_spaces => shift)->parse( "<d> \n<e/></d>")->_dump'
  9593.  
  9594.  
  9595. C<keep_spaces> and C<discard_spaces> cannot be both set.
  9596.  
  9597. =item discard_spaces_in
  9598.  
  9599. This argument sets C<keep_spaces> to true but will cause the twig builder to
  9600. discard spaces in the elements listed.
  9601.  
  9602. The syntax for using this argument is:
  9603.  
  9604.   XML::Twig->new( discard_spaces_in => [ 'elt1', 'elt2']);
  9605.  
  9606. =item keep_spaces_in
  9607.  
  9608. This argument sets C<discard_spaces> to true but will cause the twig builder to
  9609. keep spaces in the elements listed.
  9610.  
  9611. The syntax for using this argument is: 
  9612.  
  9613.   XML::Twig->new( keep_spaces_in => [ 'elt1', 'elt2']);
  9614.  
  9615. B<Warning>: adding this option can result in changes in the twig generated:
  9616. space that was previously discarded might end up in a new text element.
  9617.  
  9618. =item pretty_print
  9619.  
  9620. Set the pretty print method, amongst 'C<none>' (default), 'C<nsgmls>', 
  9621. 'C<nice>', 'C<indented>', 'C<indented_c>', 'C<indented_a>', C<cvs>, 
  9622. C<wrapped>, 'C<record>' and 'C<record_c>'
  9623.  
  9624. pretty_print formats:
  9625.  
  9626. =over 4
  9627.  
  9628. =item none
  9629.  
  9630. The document is output as one ling string, with no line breaks except those 
  9631. found within text elements
  9632.  
  9633. =item nsgmls
  9634.  
  9635. Line breaks are inserted in safe places: that is within tags, between a tag 
  9636. and an attribute, between attributes and before the > at the end of a tag.
  9637.  
  9638. This is quite ugly but better than C<none>, and it is very safe, the document 
  9639. will still be valid (conforming to its DTD).
  9640.  
  9641. This is how the SGML parser C<sgmls> splits documents, hence the name.
  9642.  
  9643. =item nice
  9644.  
  9645. This option inserts line breaks before any tag that does not contain text (so
  9646. element with textual content are not broken as the \n is the significant).
  9647.  
  9648. B<WARNING>: this option leaves the document well-formed but might make it
  9649. invalid (not conformant to its DTD). If you have elements declared as
  9650.  
  9651.   <!ELEMENT foo (#PCDATA|bar)>
  9652.  
  9653. then a C<foo> element including a C<bar> one will be printed as
  9654.  
  9655.   <foo>
  9656.   <bar>bar is just pcdata</bar>
  9657.   </foo>
  9658.  
  9659. This is invalid, as the parser will take the line break after the C<foo> tag 
  9660. as a sign that the element contains PCDATA, it will then die when it finds the 
  9661. C<bar> tag. This may or may not be important for you, but be aware of it!
  9662.  
  9663. =item indented
  9664.  
  9665. Same as C<nice> (and with the same warning) but indents elements according to 
  9666. their level 
  9667.  
  9668. =item indented_c
  9669.  
  9670. Same as C<indented> but a little more compact: the closing tags are on the 
  9671. same line as the preceding text
  9672.  
  9673. =item idented_a
  9674.  
  9675. This formats XML files in a line-oriented version control friendly way. 
  9676. The format is described in L<http://tinyurl.com/2kwscq> (that's an Oracle
  9677. document with an insanely long URL).
  9678.  
  9679. Note that to be totaly conformant to the "spec", the order of attributes
  9680. should not be changed, so if they are not already in alphabetical order
  9681. you will need to use the C<L<keep_atts_order>> option.
  9682.  
  9683. =item cvs
  9684.  
  9685. Same as C<L<idented_a>>.
  9686.  
  9687. =item wrapped
  9688.  
  9689. Same as C<indented_c> but lines are wrapped using L<Text::Wrap::wrap>. The 
  9690. default length for lines is the default for C<$Text::Wrap::columns>, and can
  9691. be changed by changing that variable.
  9692.  
  9693. =item record
  9694.  
  9695. This is a record-oriented pretty print, that display data in records, one field 
  9696. per line (which looks a LOT like C<indented>)
  9697.  
  9698. =item record_c
  9699.  
  9700. Stands for record compact, one record per line
  9701.  
  9702. =back
  9703.  
  9704.  
  9705. =item empty_tags
  9706.  
  9707. Set the empty tag display style ('C<normal>', 'C<html>' or 'C<expand>').
  9708.  
  9709. C<normal> outputs an empty tag 'C<< <tag/> >>', C<html> adds a space 
  9710. 'C<< <tag /> >>' for elements that can be empty in XHTML and C<expand> outputs
  9711. 'C<< <tag></tag> >>'
  9712.  
  9713. =item quote
  9714.  
  9715. Set the quote character for attributes ('C<single>' or 'C<double>').
  9716.  
  9717. =item comments
  9718.  
  9719. Set the way comments are processed: 'C<drop>' (default), 'C<keep>' or 
  9720. 'C<process>' 
  9721.  
  9722. Comments processing options:
  9723.  
  9724. =over 4
  9725.  
  9726. =item drop
  9727.  
  9728. drops the comments, they are not read, nor printed to the output
  9729.  
  9730. =item keep
  9731.  
  9732. comments are loaded and will appear on the output, they are not 
  9733. accessible within the twig and will not interfere with processing
  9734. though
  9735.  
  9736. B<Note>: comments in the middle of a text element such as 
  9737.  
  9738.   <p>text <!-- comment --> more text --></p>
  9739.  
  9740. are kept at their original position in the text. Using "print"
  9741. methods like C<print> or C<sprint> will return the comments in the
  9742. text. Using C<text> or C<field> on the other hand will not.
  9743.  
  9744. Any use of C<set_pcdata> on the C<#PCDATA> element (directly or 
  9745. through other methods like C<set_content>) will delete the comment(s).
  9746.  
  9747. =item process
  9748.  
  9749. comments are loaded in the twig and will be treated as regular elements 
  9750. (their C<tag> is C<#COMMENT>) this can interfere with processing if you
  9751. expect C<< $elt->{first_child} >> to be an element but find a comment there.
  9752. Validation will not protect you from this as comments can happen anywhere.
  9753. You can use C<< $elt->first_child( 'tag') >> (which is a good habit anyway)
  9754. to get where you want. 
  9755.  
  9756. Consider using C<process> if you are outputting SAX events from XML::Twig.
  9757.  
  9758. =back
  9759.  
  9760. =item pi
  9761.  
  9762. Set the way processing instructions are processed: 'C<drop>', 'C<keep>' 
  9763. (default) or 'C<process>'
  9764.  
  9765. Note that you can also set PI handlers in the C<twig_handlers> option: 
  9766.  
  9767.   '?'       => \&handler
  9768.   '?target' => \&handler 2
  9769.  
  9770. The handlers will be called with 2 parameters, the twig and the PI element if
  9771. C<pi> is set to C<process>, and with 3, the twig, the target and the data if
  9772. C<pi> is set to C<keep>. Of course they will not be called if C<pi> is set to 
  9773. C<drop>.
  9774.  
  9775. If C<pi> is set to C<keep> the handler should return a string that will be used
  9776. as-is as the PI text (it should look like "C< <?target data?> >" or '' if you
  9777. want to remove the PI), 
  9778.  
  9779. Only one handler will be called, C<?target> or C<?> if no specific handler for
  9780. that target is available.
  9781.  
  9782. =item map_xmlns 
  9783.  
  9784. This option is passed a hashref that maps uri's to prefixes. The prefixes in
  9785. the document will be replaced by the ones in the map. The mapped prefixes can
  9786. (actually have to) be used to trigger handlers, navigate or query the document.
  9787.  
  9788. Here is an example:
  9789.  
  9790.   my $t= XML::Twig->new( map_xmlns => {'http://www.w3.org/2000/svg' => "svg"},
  9791.                          twig_handlers => 
  9792.                            { 'svg:circle' => sub { $_->set_att( r => 20) } },
  9793.                          pretty_print => 'indented', 
  9794.                        )
  9795.                   ->parse( '<doc xmlns:gr="http://www.w3.org/2000/svg">
  9796.                               <gr:circle cx="10" cy="90" r="10"/>
  9797.                            </doc>'
  9798.                          )
  9799.                   ->print;
  9800.  
  9801. This will output:
  9802.  
  9803.   <doc xmlns:svg="http://www.w3.org/2000/svg">
  9804.      <svg:circle cx="10" cy="90" r="20"/>
  9805.   </doc>
  9806.  
  9807. =item keep_original_prefix
  9808.  
  9809. When used with C<L<map_xmlns>> this option will make C<XML::Twig> use the original
  9810. namespace prefixes when outputting a document. The mapped prefix will still be used
  9811. for triggering handlers and in navigation and query methods.
  9812.  
  9813.   my $t= XML::Twig->new( map_xmlns => {'http://www.w3.org/2000/svg' => "svg"},
  9814.                          twig_handlers => 
  9815.                            { 'svg:circle' => sub { $_->set_att( r => 20) } },
  9816.                          keep_original_prefix => 1,
  9817.                          pretty_print => 'indented', 
  9818.                        )
  9819.                   ->parse( '<doc xmlns:gr="http://www.w3.org/2000/svg">
  9820.                               <gr:circle cx="10" cy="90" r="10"/>
  9821.                            </doc>'
  9822.                          )
  9823.                   ->print;
  9824.  
  9825. This will output:
  9826.  
  9827.   <doc xmlns:gr="http://www.w3.org/2000/svg">
  9828.      <gr:circle cx="10" cy="90" r="20"/>
  9829.   </doc>
  9830.  
  9831. =item index ($arrayref or $hashref)
  9832.  
  9833. This option creates lists of specific elements during the parsing of the XML.
  9834. It takes a reference to either a list of triggering expressions or to a hash 
  9835. name => expression, and for each one generates the list of elements that 
  9836. match the expression. The list can be accessed through the C<L<index>> method.
  9837.  
  9838. example:
  9839.  
  9840.   # using an array ref
  9841.   my $t= XML::Twig->new( index => [ 'div', 'table' ])
  9842.                   ->parsefile( "foo.xml');
  9843.   my $divs= $t->index( 'div');
  9844.   my $first_div= $divs->[0];
  9845.   my $last_table= $t->index( table => -1);
  9846.  
  9847.   # using a hashref to name the indexes
  9848.   my $t= XML::Twig->new( index => { email => 'a[@href=~/^\s*mailto:/]')
  9849.                   ->parsefile( "foo.xml');
  9850.   my $last_emails= $t->index( email => -1);
  9851.  
  9852. Note that the index is not maintained after the parsing. If elements are 
  9853. deleted, renamed or otherwise hurt during processing, the index is NOT updated.
  9854.  
  9855.  
  9856. =back
  9857.  
  9858. B<Note>: I _HATE_ the Java-like name of arguments used by most XML modules.
  9859. So in pure TIMTOWTDI fashion all arguments can be written either as
  9860. C<UglyJavaLikeName> or as C<readable_perl_name>: C<twig_print_outside_roots>
  9861. or C<TwigPrintOutsideRoots> (or even C<twigPrintOutsideRoots> {shudder}). 
  9862. XML::Twig normalizes them before processing them.
  9863.  
  9864. =item parse ( $source)
  9865.  
  9866. The C<$source> parameter should either be a string containing the whole XML
  9867. document, or it should be an open C<IO::Handle>. Constructor options to
  9868. C<XML::Parser::Expat> given as keyword-value pairs may follow theC<$source> 
  9869. parameter. These override, for this call, any options or attributes passed
  9870. through from the XML::Parser instance.
  9871.  
  9872. A die call is thrown if a parse error occurs. Otherwise it will return 
  9873. the twig built by the parse. Use C<safe_parse> if you want the parsing
  9874. to return even when an error occurs.
  9875.  
  9876. If this method is called as a class method
  9877. (C<< XML::Twig->parse( $some_xml_or_html) >>) then an XML::Twig object is 
  9878. created, using the parameters except the last one (eg 
  9879. C<< XML::Twig->parse( pretty_print => 'indented', $some_xml_or_html) >>)
  9880. and C<L<xparse>> is called on it.
  9881.  
  9882. =item parsestring
  9883.  
  9884. This is just an alias for C<parse> for backwards compatibility.
  9885.  
  9886. =item parsefile (FILE [, OPT => OPT_VALUE [...]])
  9887.  
  9888. Open C<FILE> for reading, then call C<parse> with the open handle. The file
  9889. is closed no matter how C<parse> returns. 
  9890.  
  9891. A C<die> call is thrown if a parse error occurs. Otherwise it will return 
  9892. the twig built by the parse. Use C<safe_parsefile> if you want the parsing
  9893. to return even when an error occurs.
  9894.  
  9895. =item parsefile_inplace ( $file, $optional_extension)
  9896.  
  9897. Parse and update a file "in place". It does this by creating a temp file,
  9898. selecting it as the default for print() statements (and methods), then parsing
  9899. the input file. If the parsing is successful, then the temp file is 
  9900. moved to replace the input file.
  9901.  
  9902. If an extension is given then the original file is backed-up (the rules for
  9903. the extension are the same as the rule for the -i option in perl).
  9904.  
  9905. =item parsefile_html_inplace ( $file, $optional_extension)
  9906.  
  9907. Same as parsefile_inplace, except that it parses HTML instead of XML 
  9908.  
  9909. =item parseurl ($url $optional_user_agent)
  9910.  
  9911. Gets the data from C<$url> and parse it. The data is piped to the parser in 
  9912. chunks the size of the XML::Parser::Expat buffer, so memory consumption and
  9913. hopefully speed are optimal.
  9914.  
  9915. For most (read "small") XML it is probably as efficient (and easier to debug)
  9916. to just C<get> the XML file and then parse it as a string.
  9917.  
  9918.   use XML::Twig;
  9919.   use LWP::Simple;
  9920.   my $twig= XML::Twig->new();
  9921.   $twig->parse( LWP::Simple::get( $URL ));
  9922.  
  9923. or
  9924.  
  9925.   use XML::Twig;
  9926.   my $twig= XML::Twig->nparse( $URL);
  9927.  
  9928.  
  9929. If the C<$optional_user_agent> argument is used then it is used, otherwise a
  9930. new one is created.
  9931.  
  9932. =item safe_parse ( SOURCE [, OPT => OPT_VALUE [...]])
  9933.  
  9934. This method is similar to C<parse> except that it wraps the parsing in an
  9935. C<eval> block. It returns the twig on success and 0 on failure (the twig object
  9936. also contains the parsed twig). C<$@> contains the error message on failure.
  9937.  
  9938. Note that the parsing still stops as soon as an error is detected, there is
  9939. no way to keep going after an error.
  9940.  
  9941. =item safe_parsefile (FILE [, OPT => OPT_VALUE [...]])
  9942.  
  9943. This method is similar to C<parsefile> except that it wraps the parsing in an
  9944. C<eval> block. It returns the twig on success and 0 on failure (the twig object
  9945. also contains the parsed twig) . C<$@> contains the error message on failure
  9946.  
  9947. Note that the parsing still stops as soon as an error is detected, there is
  9948. no way to keep going after an error.
  9949.  
  9950. =item safe_parseurl ($url $optional_user_agent)
  9951.  
  9952. Same as C<parseurl> except that it wraps the parsing in an C<eval> block. It 
  9953. returns the twig on success and 0 on failure (the twig object also contains
  9954. the parsed twig) . C<$@> contains the error message on failure
  9955.  
  9956. =item parse_html ($string_or_fh)
  9957.  
  9958. parse an HTML string or file handle (by converting it to XML using
  9959. HTML::TreeBuilder, which needs to be available).
  9960.  
  9961. This works nicely, but some information gets lost in the process:
  9962. newlines are removed, and (at least on the version I use), comments
  9963. get get an extra CDATA section inside ( <!-- foo --> becomes
  9964. <!-- <![CDATA[ foo ]]> -->
  9965.  
  9966. =item parsefile_html
  9967.  
  9968. parse an HTML file (by converting it to XML using HTML::TreeBuilder, which 
  9969. needs to be available). The file is loaded completely in memory and converted
  9970. to XML before being parsed.
  9971.  
  9972. B<Alpha>: implementation, and thus generated XML could change. 
  9973.  
  9974. =item safe_parseurl_html ($url $optional_user_agent)
  9975.  
  9976. Same as C<L<parseurl_html>>> except that it wraps the parsing in an C<eval>
  9977. block.  It returns the twig on success and 0 on failure (the twig object also
  9978. contains the parsed twig) . C<$@> contains the error message on failure
  9979.  
  9980. =item safe_parsefile_html ($file $optional_user_agent)
  9981.  
  9982. Same as C<L<parsefile_html>>> except that it wraps the parsing in an C<eval> 
  9983. block.  It returns the twig on success and 0 on failure (the twig object also 
  9984. contains the parsed twig) . C<$@> contains the error message on failure
  9985.  
  9986. =item safe_parse_html ($string_or_fh)
  9987.  
  9988. Same as C<L<parse_html>> except that it wraps the parsing in an C<eval> block. 
  9989. It returns the twig on success and 0 on failure (the twig object also contains
  9990. the parsed twig) . C<$@> contains the error message on failure
  9991.  
  9992. =item xparse ($thing_to_parse)
  9993.  
  9994. parse the C<$thing_to_parse>, whether it is a filehandle, a string, an HTML 
  9995. file, an HTML URL, an URL or a file.
  9996.  
  9997. Note that this is mostly a convenience method for one-off scripts. For example
  9998. files that end in '.htm' or '.html' are parsed first as XML, and if this fails
  9999. as HTML. This is certainly not the most efficient way to do this in general.
  10000.  
  10001. =item nparse ($optional_twig_options, $thing_to_parse)
  10002.  
  10003. create a twig with the C<$optional_options>, and parse the C<$thing_to_parse>, 
  10004. whether it is a filehandle, a string, an HTML file, an HTML URL, an URL or a 
  10005. file.
  10006.  
  10007. Examples:
  10008.  
  10009.    XML::Twig->nparse( "file.xml");
  10010.    XML::Twig->nparse( error_context => 1, "file://file.xml");
  10011.  
  10012. =item nparse_pp ($optional_twig_options, $thing_to_parse)
  10013.  
  10014. same as C<L<nparse>> but also sets the C<pretty_print> option to C<indented>.
  10015.  
  10016. =item nparse_e ($optional_twig_options, $thing_to_parse)
  10017.  
  10018. same as C<L<nparse>> but also sets the C<error_context> option to 1.
  10019.  
  10020. =item nparse_ppe ($optional_twig_options, $thing_to_parse)
  10021.  
  10022. same as C<L<nparse>> but also sets the C<pretty_print> option to C<indented>
  10023. and the C<error_context> option to 1.
  10024.  
  10025. =item parser
  10026.  
  10027. This method returns the C<expat> object (actually the XML::Parser::Expat object) 
  10028. used during parsing. It is useful for example to call XML::Parser::Expat methods
  10029. on it. To get the line of a tag for example use C<< $t->parser->current_line >>.
  10030.  
  10031. =item setTwigHandlers ($handlers)
  10032.  
  10033. Set the twig_handlers. C<$handlers> is a reference to a hash similar to the
  10034. one in the C<twig_handlers> option of new. All previous handlers are unset.
  10035. The method returns the reference to the previous handlers.
  10036.  
  10037. =item setTwigHandler ($exp $handler)
  10038.  
  10039. Set a single twig_handler for elements matching C<$exp>. C<$handler> is a 
  10040. reference to a subroutine. If the handler was previously set then the reference 
  10041. to the previous handler is returned.
  10042.  
  10043. =item setStartTagHandlers ($handlers)
  10044.  
  10045. Set the start_tag handlers. C<$handlers> is a reference to a hash similar to the
  10046. one in the C<start_tag_handlers> option of new. All previous handlers are unset.
  10047. The method returns the reference to the previous handlers.
  10048.  
  10049. =item setStartTagHandler ($exp $handler)
  10050.  
  10051. Set a single start_tag handlers for elements matching C<$exp>. C<$handler> is a 
  10052. reference to a subroutine. If the handler was previously set then the reference
  10053. to the previous handler is returned.
  10054.  
  10055. =item setEndTagHandlers ($handlers)
  10056.  
  10057. Set the end_tag handlers. C<$handlers> is a reference to a hash similar to the
  10058. one in the C<end_tag_handlers> option of new. All previous handlers are unset.
  10059. The method returns the reference to the previous handlers.
  10060.  
  10061. =item setEndTagHandler ($exp $handler)
  10062.  
  10063. Set a single end_tag handlers for elements matching C<$exp>. C<$handler> is a 
  10064. reference to a subroutine. If the handler was previously set then the 
  10065. reference to the previous handler is returned.
  10066.  
  10067. =item setTwigRoots ($handlers)
  10068.  
  10069. Same as using the C<L<twig_roots>> option when creating the twig
  10070.  
  10071. =item setCharHandler ($exp $handler)
  10072.  
  10073. Set a C<char_handler>
  10074.  
  10075. =item setIgnoreEltsHandler ($exp)
  10076.  
  10077. Set a C<ignore_elt> handler (elements that match C<$exp> will be ignored
  10078.  
  10079. =item setIgnoreEltsHandlers ($exp)
  10080.  
  10081. Set all C<ignore_elt> handlers (previous handlers are replaced)
  10082.  
  10083. =item dtd
  10084.  
  10085. Return the dtd (an L<XML::Twig::DTD> object) of a twig
  10086.  
  10087. =item xmldecl
  10088.  
  10089. Return the XML declaration for the document, or a default one if it doesn't
  10090. have one
  10091.  
  10092. =item doctype
  10093.  
  10094. Return the doctype for the document
  10095.  
  10096. =item doctype_name
  10097.  
  10098. returns the doctype of the document from the doctype declaration
  10099.  
  10100. =item system_id
  10101.  
  10102. returns the system value of the DTD of the document from the doctype declaration
  10103.  
  10104. =item public_id
  10105.  
  10106. returns the public doctype of the document from the doctype declaration
  10107.  
  10108. =item internal_subset
  10109.  
  10110. returns the internal subset of the DTD
  10111.  
  10112. =item dtd_text
  10113.  
  10114. Return the DTD text
  10115.  
  10116. =item dtd_print
  10117.  
  10118. Print the DTD
  10119.  
  10120. =item model ($tag)
  10121.  
  10122. Return the model (in the DTD) for the element C<$tag>
  10123.  
  10124. =item root
  10125.  
  10126. Return the root element of a twig
  10127.  
  10128. =item set_root ($elt)
  10129.  
  10130. Set the root of a twig
  10131.  
  10132. =item first_elt ($optional_condition)
  10133.  
  10134. Return the first element matching C<$optional_condition> of a twig, if
  10135. no condition is given then the root is returned
  10136.  
  10137. =item last_elt ($optional_condition)
  10138.  
  10139. Return the last element matching C<$optional_condition> of a twig, if
  10140. no condition is given then the last element of the twig is returned
  10141.  
  10142. =item elt_id        ($id)
  10143.  
  10144. Return the element whose C<id> attribute is $id
  10145.  
  10146. =item getEltById
  10147.  
  10148. Same as C<L<elt_id>>
  10149.  
  10150. =item index ($index_name, $optional_index)
  10151.  
  10152. If the C<$optional_index> argument is present, return the corresponding element
  10153. in the index (created using the C<index> option for C<XML::Twig->new>)
  10154.  
  10155. If the argument is not present, return an arrayref to the index
  10156.  
  10157. =item normalize
  10158.  
  10159. merge together all consecutive pcdata elements in the document (if for example
  10160. you have turned some elements into pcdata using C<L<erase>>, this will give you
  10161. a "clean" document in which there all text elements are as long as possible).
  10162.  
  10163. =item encoding
  10164.  
  10165. This method returns the encoding of the XML document, as defined by the 
  10166. C<encoding> attribute in the XML declaration (ie it is C<undef> if the attribute
  10167. is not defined)
  10168.  
  10169. =item set_encoding
  10170.  
  10171. This method sets the value of the C<encoding> attribute in the XML declaration. 
  10172. Note that if the document did not have a declaration it is generated (with
  10173. an XML version of 1.0)
  10174.  
  10175. =item xml_version
  10176.  
  10177. This method returns the XML version, as defined by the C<version> attribute in 
  10178. the XML declaration (ie it is C<undef> if the attribute is not defined)
  10179.  
  10180. =item set_xml_version
  10181.  
  10182. This method sets the value of the C<version> attribute in the XML declaration. 
  10183. If the declaration did not exist it is created.
  10184.  
  10185. =item standalone
  10186.  
  10187. This method returns the value of the C<standalone> declaration for the document
  10188.  
  10189. =item set_standalone
  10190.  
  10191. This method sets the value of the C<standalone> attribute in the XML 
  10192. declaration.  Note that if the document did not have a declaration it is 
  10193. generated (with an XML version of 1.0)
  10194.  
  10195. =item set_output_encoding
  10196.  
  10197. Set the C<encoding> "attribute" in the XML declaration
  10198.  
  10199. =item set_doctype ($name, $system, $public, $internal)
  10200.  
  10201. Set the doctype of the element. If an argument is C<undef> (or not present)
  10202. then its former value is retained, if a false ('' or 0) value is passed then
  10203. the former value is deleted;
  10204.  
  10205. =item entity_list
  10206.  
  10207. Return the entity list of a twig
  10208.  
  10209. =item entity_names
  10210.  
  10211. Return the list of all defined entities
  10212.  
  10213. =item entity ($entity_name)
  10214.  
  10215. Return the entity 
  10216.  
  10217. =item change_gi      ($old_gi, $new_gi)
  10218.  
  10219. Performs a (very fast) global change. All elements C<$old_gi> are now 
  10220. C<$new_gi>. This is a bit dangerous though and should be avoided if
  10221. < possible, as the new tag might be ignored in subsequent processing.
  10222.  
  10223. See C<L<BUGS|BUGS> >
  10224.  
  10225. =item flush            ($optional_filehandle, %options)
  10226.  
  10227. Flushes a twig up to (and including) the current element, then deletes
  10228. all unnecessary elements from the tree that's kept in memory.
  10229. C<flush> keeps track of which elements need to be open/closed, so if you
  10230. flush from handlers you don't have to worry about anything. Just keep 
  10231. flushing the twig every time you're done with a sub-tree and it will
  10232. come out well-formed. After the whole parsing don't forget toC<flush> 
  10233. one more time to print the end of the document.
  10234. The doctype and entity declarations are also printed.
  10235.  
  10236. flush take an optional filehandle as an argument.
  10237.  
  10238. options: use the C<update_DTD> option if you have updated the (internal) DTD 
  10239. and/or the entity list and you want the updated DTD to be output 
  10240.  
  10241. The C<pretty_print> option sets the pretty printing of the document.
  10242.  
  10243.    Example: $t->flush( Update_DTD => 1);
  10244.             $t->flush( $filehandle, pretty_print => 'indented');
  10245.             $t->flush( \*FILE);
  10246.  
  10247.  
  10248. =item flush_up_to ($elt, $optional_filehandle, %options)
  10249.  
  10250. Flushes up to the C<$elt> element. This allows you to keep part of the
  10251. tree in memory when you C<flush>.
  10252.  
  10253. options: see flush.
  10254.  
  10255. =item purge
  10256.  
  10257. Does the same as a C<flush> except it does not print the twig. It just deletes
  10258. all elements that have been completely parsed so far.
  10259.  
  10260. =item purge_up_to ($elt)
  10261.  
  10262. Purges up to the C<$elt> element. This allows you to keep part of the tree in 
  10263. memory when you C<purge>.
  10264.  
  10265. =item print            ($optional_filehandle, %options)
  10266.  
  10267. Prints the whole document associated with the twig. To be used only AFTER the
  10268. parse.
  10269.  
  10270. options: see C<flush>.
  10271.  
  10272. =item print_to_file    ($filename, %options)
  10273.  
  10274. Prints the whole document associated with the twig to file C<$filename>.
  10275. To be used only AFTER the parse.
  10276.  
  10277. options: see C<flush>.
  10278.  
  10279. =item sprint
  10280.  
  10281. Return the text of the whole document associated with the twig. To be used only
  10282. AFTER the parse.
  10283.  
  10284. options: see C<flush>.
  10285.  
  10286. =item trim
  10287.  
  10288. Trim the document: gets rid of initial and trailing spaces, and replaces multiple spaces
  10289. by a single one.
  10290.  
  10291. =item toSAX1 ($handler)
  10292.  
  10293. Send SAX events for the twig to the SAX1 handler C<$handler>
  10294.  
  10295. =item toSAX2 ($handler)
  10296.  
  10297. Send SAX events for the twig to the SAX2 handler C<$handler>
  10298.  
  10299. =item flush_toSAX1 ($handler)
  10300.  
  10301. Same as flush, except that SAX events are sent to the SAX1 handler
  10302. C<$handler> instead of the twig being printed
  10303.  
  10304. =item flush_toSAX2 ($handler)
  10305.  
  10306. Same as flush, except that SAX events are sent to the SAX2 handler
  10307. C<$handler> instead of the twig being printed
  10308.  
  10309. =item ignore
  10310.  
  10311. This method should be called during parsing, usually in C<start_tag_handlers>.
  10312. It causes the element to be skipped during the parsing: the twig is not built
  10313. for this element, it will not be accessible during parsing or after it. The 
  10314. element will not take up any memory and parsing will be faster.
  10315.  
  10316. Note that this method can also be called on an element. If the element is a 
  10317. parent of the current element then this element will be ignored (the twig will
  10318. not be built any more for it and what has already been built will be deleted).
  10319.  
  10320. =item set_pretty_print  ($style)
  10321.  
  10322. Set the pretty print method, amongst 'C<none>' (default), 'C<nsgmls>', 
  10323. 'C<nice>', 'C<indented>', C<indented_c>, 'C<wrapped>', 'C<record>' and 
  10324. 'C<record_c>'
  10325.  
  10326. B<WARNING:> the pretty print style is a B<GLOBAL> variable, so once set it's
  10327. applied to B<ALL> C<print>'s (and C<sprint>'s). Same goes if you use XML::Twig
  10328. with C<mod_perl> . This should not be a problem as the XML that's generated 
  10329. is valid anyway, and XML processors (as well as HTML processors, including
  10330. browsers) should not care. Let me know if this is a big problem, but at the
  10331. moment the performance/cleanliness trade-off clearly favors the global 
  10332. approach.
  10333.  
  10334. =item set_empty_tag_style  ($style)
  10335.  
  10336. Set the empty tag display style ('C<normal>', 'C<html>' or 'C<expand>'). As 
  10337. with C<L<set_pretty_print>> this sets a global flag.  
  10338.  
  10339. C<normal> outputs an empty tag 'C<< <tag/> >>', C<html> adds a space 
  10340. 'C<< <tag /> >>' for elements that can be empty in XHTML and C<expand> outputs
  10341. 'C<< <tag></tag> >>'
  10342.  
  10343. =item set_remove_cdata  ($flag)
  10344.  
  10345. set (or unset) the flag that forces the twig to output CDATA sections as 
  10346. regular (escaped) PCDATA
  10347.  
  10348. =item print_prolog     ($optional_filehandle, %options)
  10349.  
  10350. Prints the prolog (XML declaration + DTD + entity declarations) of a document.
  10351.  
  10352. options: see C<L<flush>>.
  10353.  
  10354. =item prolog     ($optional_filehandle, %options)
  10355.  
  10356. Return the prolog (XML declaration + DTD + entity declarations) of a document.
  10357.  
  10358. options: see C<L<flush>>.
  10359.  
  10360. =item finish
  10361.  
  10362. Call Expat C<finish> method.
  10363. Unsets all handlers (including internal ones that set context), but expat
  10364. continues parsing to the end of the document or until it finds an error.
  10365. It should finish up a lot faster than with the handlers set.
  10366.  
  10367. =item finish_print
  10368.  
  10369. Stops twig processing, flush the twig and proceed to finish printing the 
  10370. document as fast as possible. Use this method when modifying a document and 
  10371. the modification is done. 
  10372.  
  10373. =item finish_now
  10374.  
  10375. Stops twig processing, does not finish parsing the document (which could
  10376. actually be not well-formed after the point where C<finish_now> is called).
  10377. Execution resumes after the C<Lparse>> or C<L<parsefile>> call. The content
  10378. of the twig is what has been parsed so far (all open elements at the time 
  10379. C<finish_now> is called are considered closed).
  10380.  
  10381. =item set_expand_external_entities
  10382.  
  10383. Same as using the C<L<expand_external_ents>> option when creating the twig
  10384.  
  10385. =item set_input_filter
  10386.  
  10387. Same as using the C<L<input_filter>> option when creating the twig
  10388.  
  10389. =item set_keep_atts_order
  10390.  
  10391. Same as using the C<L<keep_atts_order>> option when creating the twig
  10392.  
  10393. =item set_keep_encoding
  10394.  
  10395. Same as using the C<L<keep_encoding>> option when creating the twig
  10396.  
  10397. =item set_output_filter
  10398.  
  10399. Same as using the C<L<output_filter>> option when creating the twig
  10400.  
  10401. =item set_output_text_filter
  10402.  
  10403. Same as using the C<L<output_text_filter>> option when creating the twig
  10404.  
  10405. =item add_stylesheet ($type, @options)
  10406.  
  10407. Adds an external stylesheet to an XML document.
  10408.  
  10409. Supported types and options:
  10410.  
  10411. =over 4
  10412.  
  10413. =item xsl
  10414.  
  10415. option: the url of the stylesheet
  10416.  
  10417. Example:
  10418.  
  10419.   $t->add_stylesheet( xsl => "xsl_style.xsl");
  10420.  
  10421. will generate the following PI at the beginning of the document:
  10422.  
  10423.   <?xml-stylesheet type="text/xsl" href="xsl_style.xsl"?>
  10424.  
  10425. =item css
  10426.  
  10427. option: the url of the stylesheet
  10428.  
  10429.  
  10430. =back
  10431.  
  10432. =item Methods inherited from XML::Parser::Expat
  10433.  
  10434. A twig inherits all the relevant methods from XML::Parser::Expat. These 
  10435. methods can only be used during the parsing phase (they will generate
  10436. a fatal error otherwise).
  10437.  
  10438. Inherited methods are:
  10439.  
  10440. =over 4
  10441.  
  10442. =item depth
  10443.  
  10444. Returns the size of the context list.
  10445.  
  10446. =item in_element
  10447.  
  10448. Returns true if NAME is equal to the name of the innermost
  10449. currently opened element. If namespace processing is being used and
  10450. you want to check against a name that may be in a namespace, then
  10451. use the generate_ns_name method to create the NAME argument.
  10452.  
  10453. =item within_element
  10454.  
  10455. Returns the number of times the given name appears in the context
  10456. list.  If namespace processing is being used and you want to check
  10457. against a name that may be in a namespace, then use the
  10458. generate_ns_name method to create the NAME argument.
  10459.  
  10460. =item context
  10461.  
  10462. Returns a list of element names that represent open elements, with
  10463. the last one being the innermost. Inside start and end tag
  10464. handlers, this will be the tag of the parent element.
  10465.  
  10466. =item current_line
  10467.  
  10468. Returns the line number of the current position of the parse.
  10469.  
  10470. =item current_column
  10471.  
  10472. Returns the column number of the current position of the parse.
  10473.  
  10474. =item current_byte
  10475.  
  10476. Returns the current position of the parse.
  10477.  
  10478. =item position_in_context
  10479.  
  10480. Returns a string that shows the current parse position. LINES
  10481. should be an integer >= 0 that represents the number of lines on
  10482. either side of the current parse line to place into the returned
  10483. string.
  10484.  
  10485. =item base ([NEWBASE])
  10486.  
  10487. Returns the current value of the base for resolving relative URIs.
  10488. If NEWBASE is supplied, changes the base to that value.
  10489.  
  10490. =item current_element
  10491.  
  10492. Returns the name of the innermost currently opened element. Inside
  10493. start or end handlers, returns the parent of the element associated
  10494. with those tags.
  10495.  
  10496. =item element_index
  10497.  
  10498. Returns an integer that is the depth-first visit order of the
  10499. current element. This will be zero outside of the root element. For
  10500. example, this will return 1 when called from the start handler for
  10501. the root element start tag.
  10502.  
  10503. =item recognized_string
  10504.  
  10505. Returns the string from the document that was recognized in order
  10506. to call the current handler. For instance, when called from a start
  10507. handler, it will give us the the start-tag string. The string is
  10508. encoded in UTF-8.  This method doesn't return a meaningful string
  10509. inside declaration handlers.
  10510.  
  10511. =item original_string
  10512.  
  10513. Returns the verbatim string from the document that was recognized
  10514. in order to call the current handler. The string is in the original
  10515. document encoding. This method doesn't return a meaningful string
  10516. inside declaration handlers.
  10517.  
  10518. =item xpcroak
  10519.  
  10520. Concatenate onto the given message the current line number within
  10521. the XML document plus the message implied by ErrorContext. Then
  10522. croak with the formed message.
  10523.  
  10524. =item xpcarp 
  10525.  
  10526. Concatenate onto the given message the current line number within
  10527. the XML document plus the message implied by ErrorContext. Then
  10528. carp with the formed message.
  10529.  
  10530. =item xml_escape(TEXT [, CHAR [, CHAR ...]])
  10531.  
  10532. Returns TEXT with markup characters turned into character entities.
  10533. Any additional characters provided as arguments are also turned
  10534. into character references where found in TEXT.
  10535.  
  10536. (this method is broken on some versions of expat/XML::Parser)
  10537.  
  10538. =back
  10539.  
  10540. =item path ( $optional_tag)
  10541.  
  10542. Return the element context in a form similar to XPath's short
  10543. form: 'C</root/tag1/../tag>'
  10544.  
  10545. =item get_xpath  ( $optional_array_ref, $xpath, $optional_offset)
  10546.  
  10547. Performs a C<get_xpath> on the document root (see <Elt|"Elt">)
  10548.  
  10549. If the C<$optional_array_ref> argument is used the array must contain
  10550. elements. The C<$xpath> expression is applied to each element in turn 
  10551. and the result is union of all results. This way a first query can be
  10552. refined in further steps.
  10553.  
  10554.  
  10555. =item find_nodes ( $optional_array_ref, $xpath, $optional_offset)
  10556.  
  10557. same as C<get_xpath> 
  10558.  
  10559. =item findnodes ( $optional_array_ref, $xpath, $optional_offset)
  10560.  
  10561. same as C<get_xpath> (similar to the XML::LibXML method)
  10562.  
  10563. =item findvalue ( $optional_array_ref, $xpath, $optional_offset)
  10564.  
  10565. Return the C<join> of all texts of the results of applying C<L<get_xpath>>
  10566. to the node (similar to the XML::LibXML method)
  10567.  
  10568. =item subs_text ($regexp, $replace)
  10569.  
  10570. subs_text does text substitution on the whole document, similar to perl's 
  10571. C< s///> operator.
  10572.  
  10573. =item dispose
  10574.  
  10575. Useful only if you don't have C<Scalar::Util> or C<WeakRef> installed.
  10576.  
  10577. Reclaims properly the memory used by an XML::Twig object. As the object has
  10578. circular references it never goes out of scope, so if you want to parse lots 
  10579. of XML documents then the memory leak becomes a problem. Use
  10580. C<< $twig->dispose >> to clear this problem.
  10581.  
  10582. =item create_accessors (list_of_attribute_names)
  10583.  
  10584. A convenience method that creates l-valued accessors for attributes. 
  10585. So C<< $twig->create_accessors( 'foo') >> will create a C<foo> method
  10586. that can be called on elements:
  10587.  
  10588.   $elt->foo;         # equivalent to $elt->{'att'}->{'foo'};
  10589.   $elt->foo( 'bar'); # equivalent to $elt->set_att( foo => 'bar');
  10590.  
  10591. =item set_do_not_escape_amp_in_atts
  10592.  
  10593. An evil method, that I only document because Test::Pod::Coverage complaints otherwise,
  10594. but really, you don't want to know about it.
  10595.  
  10596. =back 
  10597.  
  10598. =head2 XML::Twig::Elt
  10599.  
  10600. =over 4
  10601.  
  10602. =item new          ($optional_tag, $optional_atts, @optional_content)
  10603.  
  10604. The C<tag> is optional (but then you can't have a content ), the C<$optional_atts> 
  10605. argument is a reference to a hash of attributes, the content can be just a 
  10606. string or a list of strings and element. A content of 'C<#EMPTY>' creates an empty 
  10607. element;
  10608.  
  10609.  Examples: my $elt= XML::Twig::Elt->new();
  10610.            my $elt= XML::Twig::Elt->new( para => { align => 'center' });  
  10611.            my $elt= XML::Twig::Elt->new( para => { align => 'center' }, 'foo');  
  10612.            my $elt= XML::Twig::Elt->new( br   => '#EMPTY');
  10613.            my $elt= XML::Twig::Elt->new( 'para');
  10614.            my $elt= XML::Twig::Elt->new( para => 'this is a para');  
  10615.            my $elt= XML::Twig::Elt->new( para => $elt3, 'another para'); 
  10616.  
  10617. The strings are not parsed, the element is not attached to any twig.
  10618.  
  10619. B<WARNING>: if you rely on ID's then you will have to set the id yourself. At
  10620. this point the element does not belong to a twig yet, so the ID attribute
  10621. is not known so it won't be stored in the ID list.
  10622.  
  10623. Note that C<#COMMENT>, C<#PCDATA> or C<#CDATA> are valid tag names, that will 
  10624. create text elements.
  10625.  
  10626. To create an element C<foo> containing a CDATA section:
  10627.  
  10628.            my $foo= XML::Twig::Elt->new( '#CDATA' => "content of the CDATA section")
  10629.                                   ->wrap_in( 'foo');
  10630.  
  10631. An attribute of '#CDATA', will create the content of the attribute as CDATA:
  10632.  
  10633.   my $elt= XML::Twig::Elt->new( 'p' => { #CDATA => 1}, 'foo < bar');
  10634.  
  10635. creates an element 
  10636.  
  10637.   <p><![CDATA[foo < bar]]></>
  10638.  
  10639. =item parse         ($string, %args)
  10640.  
  10641. Creates an element from an XML string. The string is actually
  10642. parsed as a new twig, then the root of that twig is returned.
  10643. The arguments in C<%args> are passed to the twig.
  10644. As always if the parse fails the parser will die, so use an
  10645. eval if you want to trap syntax errors.
  10646.  
  10647. As obviously the element does not exist beforehand this method has to be 
  10648. called on the class: 
  10649.  
  10650.   my $elt= parse XML::Twig::Elt( "<a> string to parse, with <sub/>
  10651.                                   <elements>, actually tons of </elements>
  10652.                   h</a>");
  10653.  
  10654. =item set_inner_xml ($string)
  10655.  
  10656. Sets the content of the element to be the tree created from the string
  10657.  
  10658. =item set_inner_html ($string)
  10659.  
  10660. Sets the content of the element, after parsing the string with an HTML
  10661. parser (HTML::Parser)
  10662.  
  10663. =item print         ($optional_filehandle, $optional_pretty_print_style)
  10664.  
  10665. Prints an entire element, including the tags, optionally to a 
  10666. C<$optional_filehandle>, optionally with a C<$pretty_print_style>.
  10667.  
  10668. The print outputs XML data so base entities are escaped.
  10669.  
  10670. =item sprint       ($elt, $optional_no_enclosing_tag)
  10671.  
  10672. Return the xml string for an entire element, including the tags. 
  10673. If the optional second argument is true then only the string inside the 
  10674. element is returned (the start and end tag for $elt are not).
  10675. The text is XML-escaped: base entities (& and < in text, & < and " in
  10676. attribute values) are turned into entities.
  10677.  
  10678. =item gi                       
  10679.  
  10680. Return the gi of the element (the gi is the C<generic identifier> the tag
  10681. name in SGML parlance).
  10682.  
  10683. C<tag> and C<name> are synonyms of C<gi>.
  10684.  
  10685. =item tag
  10686.  
  10687. Same as C<L<gi|gi>>
  10688.  
  10689. =item name
  10690.  
  10691. Same as C<L<tag|tag>>
  10692.  
  10693. =item set_gi         ($tag)
  10694.  
  10695. Set the gi (tag) of an element
  10696.  
  10697. =item set_tag        ($tag)
  10698.  
  10699. Set the tag (=C<L<tag|tag>>) of an element
  10700.  
  10701. =item set_name       ($name)
  10702.  
  10703. Set the name (=C<L<tag|tag>>) of an element
  10704.  
  10705. =item root 
  10706.  
  10707. Return the root of the twig in which the element is contained.
  10708.  
  10709. =item twig 
  10710.  
  10711. Return the twig containing the element. 
  10712.  
  10713. =item parent        ($optional_condition)
  10714.  
  10715. Return the parent of the element, or the first ancestor matching the 
  10716. C<$optional_condition>
  10717.  
  10718. =item first_child   ($optional_condition)
  10719.  
  10720. Return the first child of the element, or the first child matching the 
  10721. C<$optional_condition>
  10722.  
  10723. =item has_child ($optional_condition)
  10724.  
  10725. Return the first child of the element, or the first child matching the 
  10726. C<$optional_condition> (same as L<first_child>)
  10727.  
  10728. =item has_children ($optional_condition)
  10729.  
  10730. Return the first child of the element, or the first child matching the 
  10731. C<$optional_condition> (same as L<first_child>)
  10732.  
  10733.  
  10734. =item first_child_text   ($optional_condition)
  10735.  
  10736. Return the text of the first child of the element, or the first child
  10737.  matching the C<$optional_condition>
  10738. If there is no first_child then returns ''. This avoids getting the
  10739. child, checking for its existence then getting the text for trivial cases.
  10740.  
  10741. Similar methods are available for the other navigation methods: 
  10742.  
  10743. =over 4
  10744.  
  10745. =item last_child_text
  10746.  
  10747. =item prev_sibling_text
  10748.  
  10749. =item next_sibling_text
  10750.  
  10751. =item prev_elt_text
  10752.  
  10753. =item next_elt_text
  10754.  
  10755. =item child_text
  10756.  
  10757. =item parent_text
  10758.  
  10759. =back
  10760.  
  10761. All this methods also exist in "trimmed" variant: 
  10762.  
  10763. =over 4
  10764.  
  10765. =item first_child_trimmed_text
  10766.  
  10767. =item last_child_trimmed_text
  10768.  
  10769. =item prev_sibling_trimmed_text
  10770.  
  10771. =item next_sibling_trimmed_text
  10772.  
  10773. =item prev_elt_trimmed_text
  10774.  
  10775. =item next_elt_trimmed_text
  10776.  
  10777. =item child_trimmed_text
  10778.  
  10779. =item parent_trimmed_text
  10780.  
  10781. =back
  10782.  
  10783. =item field         ($condition)
  10784.  
  10785. Same method as C<first_child_text> with a different name
  10786.  
  10787. =item fields         ($condition_list)
  10788.  
  10789. Return the list of field (text of first child matching the conditions),
  10790. missing fields are returned as the empty string.
  10791.  
  10792. Same method as C<first_child_text> with a different name
  10793.  
  10794. =item trimmed_field         ($optional_condition)
  10795.  
  10796. Same method as C<first_child_trimmed_text> with a different name
  10797.  
  10798. =item set_field ($condition, $optional_atts, @list_of_elt_and_strings)
  10799.  
  10800. Set the content of the first child of the element that matches
  10801. C<$condition>, the rest of the arguments is the same as for C<L<set_content>>
  10802.  
  10803. If no child matches C<$condition> _and_ if C<$condition> is a valid
  10804. XML element name, then a new element by that name is created and 
  10805. inserted as the last child.
  10806.  
  10807. =item first_child_matches   ($optional_condition)
  10808.  
  10809. Return the element if the first child of the element (if it exists) passes
  10810. the C<$optional_condition> C<undef> otherwise
  10811.  
  10812.   if( $elt->first_child_matches( 'title')) ... 
  10813.  
  10814. is equivalent to
  10815.  
  10816.   if( $elt->{first_child} && $elt->{first_child}->passes( 'title')) 
  10817.  
  10818. C<first_child_is> is an other name for this method
  10819.  
  10820. Similar methods are available for the other navigation methods: 
  10821.  
  10822. =over 4
  10823.  
  10824. =item last_child_matches
  10825.  
  10826. =item prev_sibling_matches
  10827.  
  10828. =item next_sibling_matches
  10829.  
  10830. =item prev_elt_matches
  10831.  
  10832. =item next_elt_matches
  10833.  
  10834. =item child_matches
  10835.  
  10836. =item parent_matches
  10837.  
  10838. =back
  10839.  
  10840. =item is_first_child ($optional_condition)
  10841.  
  10842. returns true (the element) if the element is the first child of its parent
  10843. (optionally that satisfies the C<$optional_condition>)
  10844.  
  10845. =item is_last_child ($optional_condition)
  10846.  
  10847. returns true (the element) if the element is the first child of its parent
  10848. (optionally that satisfies the C<$optional_condition>)
  10849.  
  10850. =item prev_sibling  ($optional_condition)
  10851.  
  10852. Return the previous sibling of the element, or the previous sibling matching
  10853. C<$optional_condition>
  10854.  
  10855. =item next_sibling  ($optional_condition)
  10856.  
  10857. Return the next sibling of the element, or the first one matching 
  10858. C<$optional_condition>.
  10859.  
  10860. =item next_elt     ($optional_elt, $optional_condition)
  10861.  
  10862. Return the next elt (optionally matching C<$optional_condition>) of the element. This 
  10863. is defined as the next element which opens after the current element opens.
  10864. Which usually means the first child of the element.
  10865. Counter-intuitive as it might look this allows you to loop through the
  10866. whole document by starting from the root.
  10867.  
  10868. The C<$optional_elt> is the root of a subtree. When the C<next_elt> is out of the
  10869. subtree then the method returns undef. You can then walk a sub tree with:
  10870.  
  10871.   my $elt= $subtree_root;
  10872.   while( $elt= $elt->next_elt( $subtree_root)
  10873.     { # insert processing code here
  10874.     }
  10875.  
  10876. =item prev_elt     ($optional_condition)
  10877.  
  10878. Return the previous elt (optionally matching C<$optional_condition>) of the
  10879. element. This is the first element which opens before the current one.
  10880. It is usually either the last descendant of the previous sibling or
  10881. simply the parent
  10882.  
  10883. =item next_n_elt   ($offset, $optional_condition)
  10884.  
  10885. Return the C<$offset>-th element that matches the C<$optional_condition> 
  10886.  
  10887. =item following_elt
  10888.  
  10889. Return the following element (as per the XPath following axis)
  10890.  
  10891. =item preceding_elt
  10892.  
  10893. Return the preceding element (as per the XPath preceding axis)
  10894.  
  10895. =item following_elts
  10896.  
  10897. Return the list of following elements (as per the XPath following axis)
  10898.  
  10899. =item preceding_elts
  10900.  
  10901. Return the pst of preceding elements (as per the XPath preceding axis)
  10902.  
  10903. =item children     ($optional_condition)
  10904.  
  10905. Return the list of children (optionally which matches C<$optional_condition>) of 
  10906. the element. The list is in document order.
  10907.  
  10908. =item children_count ($optional_condition)
  10909.  
  10910. Return the number of children of the element (optionally which matches 
  10911. C<$optional_condition>)
  10912.  
  10913. =item children_text ($optional_condition)
  10914.  
  10915. In array context, reeturns an array containing the text of children of the
  10916. element (optionally which matches C<$optional_condition>)
  10917.  
  10918. In scalar context, returns the concatenation of the text of children of
  10919. the element
  10920.  
  10921. =item children_trimmed_text ($optional_condition)
  10922.  
  10923. In array context, returns an array containing the trimmed text of children 
  10924. of the element (optionally which matches C<$optional_condition>)
  10925.  
  10926. In scalar context, returns the concatenation of the trimmed text of children of
  10927. the element
  10928.  
  10929.  
  10930. =item children_copy ($optional_condition)
  10931.  
  10932. Return a list of elements that are copies of the children of the element, 
  10933. optionally which matches C<$optional_condition>
  10934.  
  10935. =item descendants     ($optional_condition)
  10936.  
  10937. Return the list of all descendants (optionally which matches 
  10938. C<$optional_condition>) of the element. This is the equivalent of the 
  10939. C<getElementsByTagName> of the DOM (by the way, if you are really a DOM 
  10940. addict, you can use C<getElementsByTagName> instead)
  10941.  
  10942. =item getElementsByTagName ($optional_condition)
  10943.  
  10944. Same as C<L<descendants>>
  10945.  
  10946. =item find_by_tag_name ($optional_condition)
  10947.  
  10948. Same as C<L<descendants>>
  10949.  
  10950. =item descendants_or_self ($optional_condition)
  10951.  
  10952. Same as C<L<descendants>> except that the element itself is included in the list
  10953. if it matches the C<$optional_condition> 
  10954.  
  10955. =item first_descendant  ($optional_condition)
  10956.  
  10957. Return the first descendant of the element that matches the condition  
  10958.  
  10959. =item last_descendant  ($optional_condition)
  10960.  
  10961. Return the last descendant of the element that matches the condition  
  10962.  
  10963. =item ancestors    ($optional_condition)
  10964.  
  10965. Return the list of ancestors (optionally matching C<$optional_condition>) of the 
  10966. element.  The list is ordered from the innermost ancestor to the outermost one
  10967.  
  10968. NOTE: the element itself is not part of the list, in order to include it 
  10969. you will have to use ancestors_or_self
  10970.  
  10971. =item ancestors_or_self     ($optional_condition)
  10972.  
  10973. Return the list of ancestors (optionally matching C<$optional_condition>) of the 
  10974. element, including the element (if it matches the condition>).  
  10975. The list is ordered from the innermost ancestor to the outermost one
  10976.  
  10977. =item passes ($condition)
  10978.  
  10979. Return the element if it passes the C<$condition> 
  10980.  
  10981. =item att          ($att)
  10982.  
  10983. Return the value of attribute C<$att> or C<undef>
  10984.  
  10985. =item set_att      ($att, $att_value)
  10986.  
  10987. Set the attribute of the element to the given value
  10988.  
  10989. You can actually set several attributes this way:
  10990.  
  10991.   $elt->set_att( att1 => "val1", att2 => "val2");
  10992.  
  10993. =item del_att      ($att)
  10994.  
  10995. Delete the attribute for the element
  10996.  
  10997. You can actually delete several attributes at once:
  10998.  
  10999.   $elt->del_att( 'att1', 'att2', 'att3');
  11000.  
  11001. =item cut
  11002.  
  11003. Cut the element from the tree. The element still exists, it can be copied
  11004. or pasted somewhere else, it is just not attached to the tree anymore.
  11005.  
  11006. Note that the "old" links to the parent, previous and next siblings can
  11007. still be accessed using the former_* methods
  11008.  
  11009. =item former_next_sibling
  11010.  
  11011. Returns the former next sibling of a cut node (or undef if the node has not been cut)
  11012.  
  11013. This makes it easier to write loops where you cut elements:
  11014.  
  11015.     my $child= $parent->first_child( 'achild');
  11016.     while( $child->{'att'}->{'cut'}) 
  11017.       { $child->cut; $child= $child->former_next_sibling; }
  11018.  
  11019. =item former_prev_sibling
  11020.  
  11021. Returns the former previous sibling of a cut node (or undef if the node has not been cut)
  11022.  
  11023. =item former_parent
  11024.  
  11025. Returns the former parent of a cut node (or undef if the node has not been cut)
  11026.  
  11027. =item cut_children ($optional_condition)
  11028.  
  11029. Cut all the children of the element (or all of those which satisfy the
  11030. C<$optional_condition>).
  11031.  
  11032. Return the list of children 
  11033.  
  11034. =item copy        ($elt)
  11035.  
  11036. Return a copy of the element. The copy is a "deep" copy: all sub elements of 
  11037. the element are duplicated.
  11038.  
  11039. =item paste       ($optional_position, $ref)
  11040.  
  11041. Paste a (previously C<cut> or newly generated) element. Die if the element
  11042. already belongs to a tree.
  11043.  
  11044. Note that the calling element is pasted:
  11045.  
  11046.   $child->paste( first_child => $existing_parent);
  11047.   $new_sibling->paste( after => $this_sibling_is_already_in_the_tree);
  11048.  
  11049. or
  11050.  
  11051.   my $new_elt= XML::Twig::Elt->new( tag => $content);
  11052.   $new_elt->paste( $position => $existing_elt);
  11053.  
  11054. Example:
  11055.  
  11056.   my $t= XML::Twig->new->parse( 'doc.xml')
  11057.   my $toc= $t->root->new( 'toc');
  11058.   $toc->paste( $t->root); # $toc is pasted as first child of the root 
  11059.   foreach my $title ($t->findnodes( '/doc/section/title'))
  11060.     { my $title_toc= $title->copy;
  11061.       # paste $title_toc as the last child of toc
  11062.       $title_toc->paste( last_child => $toc) 
  11063.     }
  11064.  
  11065. Position options:
  11066.  
  11067. =over 4
  11068.  
  11069. =item first_child (default)
  11070.  
  11071. The element is pasted as the first child of C<$ref>
  11072.  
  11073. =item last_child
  11074.  
  11075. The element is pasted as the last child of C<$ref>
  11076.  
  11077. =item before
  11078.  
  11079. The element is pasted before C<$ref>, as its previous sibling.
  11080.  
  11081. =item after
  11082.  
  11083. The element is pasted after C<$ref>, as its next sibling.
  11084.  
  11085. =item within
  11086.  
  11087. In this case an extra argument, C<$offset>, should be supplied. The element
  11088. will be pasted in the reference element (or in its first text child) at the
  11089. given offset. To achieve this the reference element will be split at the 
  11090. offset.
  11091.  
  11092. =back
  11093.  
  11094. Note that you can call directly the underlying method:
  11095.  
  11096. =over 4
  11097.  
  11098. =item paste_before
  11099.  
  11100. =item paste_after
  11101.  
  11102. =item paste_first_child
  11103.  
  11104. =item paste_last_child
  11105.  
  11106. =item paste_within
  11107.  
  11108. =back
  11109.  
  11110. =item move       ($optional_position, $ref)
  11111.  
  11112. Move an element in the tree.
  11113. This is just a C<cut> then a C<paste>.  The syntax is the same as C<paste>.
  11114.  
  11115. =item replace       ($ref)
  11116.  
  11117. Replaces an element in the tree. Sometimes it is just not possible toC<cut> 
  11118. an element then C<paste> another in its place, so C<replace> comes in handy.
  11119. The calling element replaces C<$ref>.
  11120.  
  11121. =item replace_with   (@elts)
  11122.  
  11123. Replaces the calling element with one or more elements 
  11124.  
  11125. =item delete
  11126.  
  11127. Cut the element and frees the memory.
  11128.  
  11129. =item prefix       ($text, $optional_option)
  11130.  
  11131. Add a prefix to an element. If the element is a C<PCDATA> element the text
  11132. is added to the pcdata, if the elements first child is a C<PCDATA> then the
  11133. text is added to it's pcdata, otherwise a new C<PCDATA> element is created 
  11134. and pasted as the first child of the element.
  11135.  
  11136. If the option is C<asis> then the prefix is added asis: it is created in
  11137. a separate C<PCDATA> element with an C<asis> property. You can then write:
  11138.  
  11139.   $elt1->prefix( '<b>', 'asis');
  11140.  
  11141. to create a C<< <b> >> in the output of C<print>.
  11142.  
  11143. =item suffix       ($text, $optional_option)
  11144.  
  11145. Add a suffix to an element. If the element is a C<PCDATA> element the text
  11146. is added to the pcdata, if the elements last child is a C<PCDATA> then the
  11147. text is added to it's pcdata, otherwise a new PCDATA element is created 
  11148. and pasted as the last child of the element.
  11149.  
  11150. If the option is C<asis> then the suffix is added asis: it is created in
  11151. a separate C<PCDATA> element with an C<asis> property. You can then write:
  11152.  
  11153.   $elt2->suffix( '</b>', 'asis');
  11154.  
  11155. =item trim
  11156.  
  11157. Trim the element in-place: spaces at the beginning and at the end of the element
  11158. are discarded and multiple spaces within the element (or its descendants) are 
  11159. replaced by a single space.
  11160.  
  11161. Note that in some cases you can still end up with multiple spaces, if they are
  11162. split between several elements:
  11163.  
  11164.   <doc>  text <b>  hah! </b>  yep</doc>
  11165.  
  11166. gets trimmed to
  11167.  
  11168.   <doc>text <b> hah! </b> yep</doc>
  11169.  
  11170. This is somewhere in between a bug and a feature.
  11171.  
  11172. =item normalize
  11173.  
  11174. merge together all consecutive pcdata elements in the element (if for example
  11175. you have turned some elements into pcdata using C<L<erase>>, this will give you
  11176. a "clean" element in which there all text fragments are as long as possible).
  11177.  
  11178.  
  11179. =item simplify (%options)
  11180.  
  11181. Return a data structure suspiciously similar to XML::Simple's. Options are
  11182. identical to XMLin options, see XML::Simple doc for more details (or use
  11183. DATA::dumper or YAML to dump the data structure)
  11184.  
  11185. =over 4
  11186.  
  11187. =item content_key
  11188.  
  11189. =item forcearray 
  11190.                              
  11191. =item keyattr 
  11192.  
  11193. =item noattr 
  11194.  
  11195. =item normalize_space
  11196.  
  11197. aka normalise_space
  11198.  
  11199. =item variables (%var_hash)
  11200.  
  11201. %var_hash is a hash { name => value }
  11202.  
  11203. This option allows variables in the XML to be expanded when the file is read. (there is no facility for putting the variable names back if you regenerate XML using XMLout).
  11204.  
  11205. A 'variable' is any text of the form ${name} (or $name) which occurs in an attribute value or in the text content of an element. If 'name' matches a key in the supplied hashref, ${name} will be replaced with the corresponding value from the hashref. If no matching key is found, the variable will not be replaced. 
  11206.  
  11207. =item var_att ($attribute_name)
  11208.  
  11209. This option gives the name of an attribute that will be used to create 
  11210. variables in the XML:
  11211.  
  11212.   <dirs>
  11213.     <dir name="prefix">/usr/local</dir>
  11214.     <dir name="exec_prefix">$prefix/bin</dir>
  11215.   </dirs>
  11216.  
  11217. use C<< var => 'name' >> to get $prefix replaced by /usr/local in the
  11218. generated data structure  
  11219.  
  11220. By default variables are captured by the following regexp: /$(\w+)/
  11221.     
  11222. =item var_regexp (regexp)
  11223.  
  11224. This option changes the regexp used to capture variables. The variable
  11225. name should be in $1
  11226.  
  11227. =item group_tags { grouping tag => grouped tag, grouping tag 2 => grouped tag 2...}
  11228.  
  11229. Option used to simplify the structure: elements listed will not be used.
  11230. Their children will be, they will be considered children of the element
  11231. parent.
  11232.  
  11233. If the element is:
  11234.  
  11235.   <config host="laptop.xmltwig.com">
  11236.     <server>localhost</server>
  11237.     <dirs>
  11238.       <dir name="base">/home/mrodrigu/standards</dir>
  11239.       <dir name="tools">$base/tools</dir>
  11240.     </dirs>
  11241.     <templates>
  11242.       <template name="std_def">std_def.templ</template>
  11243.       <template name="dummy">dummy</template>
  11244.     </templates>
  11245.   </config>
  11246.  
  11247. Then calling simplify with C<< group_tags => { dirs => 'dir',
  11248. templates => 'template'} >>
  11249. makes the data structure be exactly as if the start and end tags for C<dirs> and
  11250. C<templates> were not there.
  11251.  
  11252. A YAML dump of the structure 
  11253.  
  11254.   base: '/home/mrodrigu/standards'
  11255.   host: laptop.xmltwig.com
  11256.   server: localhost
  11257.   template:
  11258.     - std_def.templ
  11259.     - dummy.templ
  11260.   tools: '$base/tools'
  11261.  
  11262.  
  11263. =back
  11264.  
  11265. =item split_at        ($offset)
  11266.  
  11267. Split a text (C<PCDATA> or C<CDATA>) element in 2 at C<$offset>, the original
  11268. element now holds the first part of the string and a new element holds the
  11269. right part. The new element is returned
  11270.  
  11271. If the element is not a text element then the first text child of the element
  11272. is split
  11273.  
  11274. =item split        ( $optional_regexp, $tag1, $atts1, $tag2, $atts2...)
  11275.  
  11276. Split the text descendants of an element in place, the text is split using 
  11277. the C<$regexp>, if the regexp includes () then the matched separators will be 
  11278. wrapped in elements.  C<$1> is wrapped in $tag1, with attributes C<$atts1> if
  11279. C<$atts1> is given (as a hashref), C<$2> is wrapped in $tag2... 
  11280.  
  11281. if $elt is C<< <p>tati tata <b>tutu tati titi</b> tata tati tata</p> >>
  11282.  
  11283.   $elt->split( qr/(ta)ti/, 'foo', {type => 'toto'} )
  11284.  
  11285. will change $elt to
  11286.  
  11287.   <p><foo type="toto">ta</foo> tata <b>tutu <foo type="toto">ta</foo>
  11288.       titi</b> tata <foo type="toto">ta</foo> tata</p> 
  11289.  
  11290. The regexp can be passed either as a string or as C<qr//> (perl 5.005 and 
  11291. later), it defaults to \s+ just as the C<split> built-in (but this would be 
  11292. quite a useless behaviour without the C<$optional_tag> parameter)
  11293.  
  11294. C<$optional_tag> defaults to PCDATA or CDATA, depending on the initial element
  11295. type
  11296.  
  11297. The list of descendants is returned (including un-touched original elements 
  11298. and newly created ones)
  11299.  
  11300. =item mark        ( $regexp, $optional_tag, $optional_attribute_ref)
  11301.  
  11302. This method behaves exactly as L<split|split>, except only the newly created 
  11303. elements are returned
  11304.  
  11305. =item wrap_children ( $regexp_string, $tag, $optional_attribute_hashref)
  11306.  
  11307. Wrap the children of the element that match the regexp in an element C<$tag>.
  11308. If $optional_attribute_hashref is passed then the new element will
  11309. have these attributes.
  11310.  
  11311. The $regexp_string includes tags, within pointy brackets, as in 
  11312. C<< <title><para>+ >> and the usual Perl modifiers (+*?...). 
  11313. Tags can be further qualified with attributes:
  11314. C<< <para type="warning" classif="cosmic_secret">+ >>. The values
  11315. for attributes should be xml-escaped: C<< <candy type="M&Ms">* >>
  11316. (C<E<lt>>, C<&> B<C<E<gt>>> and C<"> should be escaped). 
  11317.  
  11318. Note that elements might get extra C<id> attributes in the process. See L<add_id>.
  11319. Use L<strip_att> to remove unwanted id's. 
  11320.  
  11321. Here is an example:
  11322.  
  11323. If the element C<$elt> has the following content:
  11324.  
  11325.   <elt>
  11326.    <p>para 1</p>
  11327.    <l_l1_1>list 1 item 1 para 1</l_l1_1>
  11328.      <l_l1>list 1 item 1 para 2</l_l1>
  11329.    <l_l1_n>list 1 item 2 para 1 (only para)</l_l1_n>
  11330.    <l_l1_n>list 1 item 3 para 1</l_l1_n>
  11331.      <l_l1>list 1 item 3 para 2</l_l1>
  11332.      <l_l1>list 1 item 3 para 3</l_l1>
  11333.    <l_l1_1>list 2 item 1 para 1</l_l1_1>
  11334.      <l_l1>list 2 item 1 para 2</l_l1>
  11335.    <l_l1_n>list 2 item 2 para 1 (only para)</l_l1_n>
  11336.    <l_l1_n>list 2 item 3 para 1</l_l1_n>
  11337.      <l_l1>list 2 item 3 para 2</l_l1>
  11338.      <l_l1>list 2 item 3 para 3</l_l1>
  11339.   </elt>
  11340.  
  11341. Then the code
  11342.  
  11343.   $elt->wrap_children( q{<l_l1_1><l_l1>*} , li => { type => "ul1" });
  11344.   $elt->wrap_children( q{<l_l1_n><l_l1>*} , li => { type => "ul" });
  11345.  
  11346.   $elt->wrap_children( q{<li type="ul1"><li type="ul">+}, "ul");
  11347.   $elt->strip_att( 'id');
  11348.   $elt->strip_att( 'type');
  11349.   $elt->print;
  11350.  
  11351. will output:
  11352.  
  11353.   <elt>
  11354.      <p>para 1</p>
  11355.      <ul>
  11356.        <li>
  11357.          <l_l1_1>list 1 item 1 para 1</l_l1_1>
  11358.          <l_l1>list 1 item 1 para 2</l_l1>
  11359.        </li>
  11360.        <li>
  11361.          <l_l1_n>list 1 item 2 para 1 (only para)</l_l1_n>
  11362.        </li>
  11363.        <li>
  11364.          <l_l1_n>list 1 item 3 para 1</l_l1_n>
  11365.          <l_l1>list 1 item 3 para 2</l_l1>
  11366.          <l_l1>list 1 item 3 para 3</l_l1>
  11367.        </li>
  11368.      </ul>
  11369.      <ul>
  11370.        <li>
  11371.          <l_l1_1>list 2 item 1 para 1</l_l1_1>
  11372.          <l_l1>list 2 item 1 para 2</l_l1>
  11373.        </li>
  11374.        <li>
  11375.          <l_l1_n>list 2 item 2 para 1 (only para)</l_l1_n>
  11376.        </li>
  11377.        <li>
  11378.          <l_l1_n>list 2 item 3 para 1</l_l1_n>
  11379.          <l_l1>list 2 item 3 para 2</l_l1>
  11380.          <l_l1>list 2 item 3 para 3</l_l1>
  11381.        </li>
  11382.      </ul>
  11383.   </elt>
  11384.  
  11385. =item subs_text ($regexp, $replace)
  11386.  
  11387. subs_text does text substitution, similar to perl's C< s///> operator.
  11388.  
  11389. C<$regexp> must be a perl regexp, created with the C<qr> operator.
  11390.  
  11391. C<$replace> can include C<$1, $2>... from the C<$regexp>. It can also be
  11392. used to create element and entities, by using 
  11393. C<< &elt( tag => { att => val }, text) >> (similar syntax as C<L<new>>) and
  11394. C<< &ent( name) >>.
  11395.  
  11396. Here is a rather complex example:
  11397.  
  11398.   $elt->subs_text( qr{(?<!do not )link to (http://([^\s,]*))},
  11399.                    'see &elt( a =>{ href => $1 }, $2)'
  11400.                  );
  11401.  
  11402. This will replace text like I<link to http://www.xmltwig.com> by 
  11403. I<< see <a href="www.xmltwig.com">www.xmltwig.com</a> >>, but not
  11404. I<do not link to...>
  11405.  
  11406. Generating entities (here replacing spaces with  ):
  11407.  
  11408.   $elt->subs_text( qr{ }, '&ent( " ")');
  11409.  
  11410. or, using a variable:
  11411.  
  11412.   my $ent=" ";
  11413.   $elt->subs_text( qr{ }, "&ent( '$ent')");
  11414.  
  11415. Note that the substitution is always global, as in using the C<g> modifier
  11416. in a perl substitution, and that it is performed on all text descendants
  11417. of the element.
  11418.  
  11419. B<Bug>: in the C<$regexp>, you can only use C<\1>, C<\2>... if the replacement
  11420. expression does not include elements or attributes. eg
  11421.  
  11422.   t->subs_text( qr/((t[aiou])\2)/, '$2');             # ok, replaces toto, tata, titi, tutu by to, ta, ti, tu
  11423.   t->subs_text( qr/((t[aiou])\2)/, '&elt(p => $1)' ); # NOK, does not find toto...
  11424.  
  11425. =item add_id ($optional_coderef)
  11426.  
  11427. Add an id to the element.
  11428.  
  11429. The id is an attribute, C<id> by default, see the C<id> option for XML::Twig
  11430. C<new> to change it. Use an id starting with C<#> to get an id that's not 
  11431. output by L<print>, L<flush> or L<sprint>, yet that allows you to use the
  11432. L<elt_id> method to get the element easily.
  11433.  
  11434. If the element already has an id, no new id is generated.
  11435.  
  11436. By default the method create an id of the form C<< twig_id_<nnnn> >>,
  11437. where C<< <nnnn> >> is a number, incremented each time the method is called
  11438. successfully.
  11439.  
  11440. =item set_id_seed ($prefix)
  11441.  
  11442. by default the id generated by C<L<add_id>> is C<< twig_id_<nnnn> >>, 
  11443. C<set_id_seed> changes the prefix to C<$prefix> and resets the number
  11444. to 1
  11445.  
  11446. =item strip_att ($att)
  11447.  
  11448. Remove the attribute C<$att> from all descendants of the element (including 
  11449. the element)
  11450.  
  11451. Return the element
  11452.  
  11453. =item change_att_name ($old_name, $new_name)
  11454.  
  11455. Change the name of the attribute from C<$old_name> to C<$new_name>. If there is no
  11456. attribute C<$old_name> nothing happens.
  11457.  
  11458. =item sort_children_on_value( %options)
  11459.  
  11460. Sort the children of the element in place according to their text.
  11461. All children are sorted. 
  11462.  
  11463. Return the element, with its children sorted.
  11464.  
  11465.  
  11466. L<%options> are
  11467.  
  11468.   type  : numeric |  alpha     (default: alpha)
  11469.   order : normal  |  reverse   (default: normal)
  11470.  
  11471. Return the element, with its children sorted
  11472.  
  11473.  
  11474. =item sort_children_on_att ($att, %options)
  11475.  
  11476. Sort the children of the  element in place according to attribute C<$att>. 
  11477. C<%options> are the same as for L<C<sort_children_on_value>>
  11478.  
  11479. Return the element.
  11480.  
  11481.  
  11482. =item sort_children_on_field ($tag, %options)
  11483.  
  11484. Sort the children of the element in place, according to the field C<$tag> (the 
  11485. text of the first child of the child with this tag). C<%options> are the same
  11486. as for L<C<sort_children_on_value>>.
  11487.  
  11488. Return the element, with its children sorted
  11489.  
  11490.  
  11491. =item sort_children( $get_key, %options) 
  11492.  
  11493. Sort the children of the element in place. The C<$get_key> argument is
  11494. a reference to a function that returns the sort key when passed an element.
  11495.  
  11496. For example:
  11497.  
  11498.   $elt->sort_children( sub { $_[0]->{'att'}->{"nb"} + $_[0]->text }, 
  11499.                        type => 'numeric', order => 'reverse'
  11500.                      );
  11501.  
  11502. =item field_to_att ($cond, $att)
  11503.  
  11504. Turn the text of the first sub-element matched by C<$cond> into the value of 
  11505. attribute C<$att> of the element. If C<$att> is omitted then C<$cond> is used 
  11506. as the name of the attribute, which makes sense only if C<$cond> is a valid
  11507. element (and attribute) name.
  11508.  
  11509. The sub-element is then cut.
  11510.  
  11511. =item att_to_field ($att, $tag)
  11512.  
  11513. Take the value of attribute C<$att> and create a sub-element C<$tag> as first
  11514. child of the element. If C<$tag> is omitted then C<$att> is used as the name of
  11515. the sub-element. 
  11516.  
  11517.  
  11518. =item get_xpath  ($xpath, $optional_offset)
  11519.  
  11520. Return a list of elements satisfying the C<$xpath>. C<$xpath> is an XPATH-like 
  11521. expression.
  11522.  
  11523. A subset of the XPATH abbreviated syntax is covered:
  11524.  
  11525.   tag
  11526.   tag[1] (or any other positive number)
  11527.   tag[last()]
  11528.   tag[@att] (the attribute exists for the element)
  11529.   tag[@att="val"]
  11530.   tag[@att=~ /regexp/]
  11531.   tag[att1="val1" and att2="val2"]
  11532.   tag[att1="val1" or att2="val2"]
  11533.   tag[string()="toto"] (returns tag elements which text (as per the text method) 
  11534.                        is toto)
  11535.   tag[string()=~/regexp/] (returns tag elements which text (as per the text 
  11536.                           method) matches regexp)
  11537.   expressions can start with / (search starts at the document root)
  11538.   expressions can start with . (search starts at the current element)
  11539.   // can be used to get all descendants instead of just direct children
  11540.   * matches any tag
  11541.   
  11542. So the following examples from the 
  11543. F<XPath recommendationL<http://www.w3.org/TR/xpath.html#path-abbrev>> work:
  11544.  
  11545.   para selects the para element children of the context node
  11546.   * selects all element children of the context node
  11547.   para[1] selects the first para child of the context node
  11548.   para[last()] selects the last para child of the context node
  11549.   */para selects all para grandchildren of the context node
  11550.   /doc/chapter[5]/section[2] selects the second section of the fifth chapter 
  11551.      of the doc 
  11552.   chapter//para selects the para element descendants of the chapter element 
  11553.      children of the context node
  11554.   //para selects all the para descendants of the document root and thus selects
  11555.      all para elements in the same document as the context node
  11556.   //olist/item selects all the item elements in the same document as the 
  11557.      context node that have an olist parent
  11558.   .//para selects the para element descendants of the context node
  11559.   .. selects the parent of the context node
  11560.   para[@type="warning"] selects all para children of the context node that have
  11561.      a type attribute with value warning 
  11562.   employee[@secretary and @assistant] selects all the employee children of the
  11563.      context node that have both a secretary attribute and an assistant 
  11564.      attribute
  11565.  
  11566.  
  11567. The elements will be returned in the document order.
  11568.  
  11569. If C<$optional_offset> is used then only one element will be returned, the one 
  11570. with the appropriate offset in the list, starting at 0
  11571.  
  11572. Quoting and interpolating variables can be a pain when the Perl syntax and the 
  11573. XPATH syntax collide, so use alternate quoting mechanisms like q or qq 
  11574. (I like q{} and qq{} myself).
  11575.  
  11576. Here are some more examples to get you started:
  11577.  
  11578.   my $p1= "p1";
  11579.   my $p2= "p2";
  11580.   my @res= $t->get_xpath( qq{p[string( "$p1") or string( "$p2")]});
  11581.  
  11582.   my $a= "a1";
  11583.   my @res= $t->get_xpath( qq{//*[@att="$a"]});
  11584.  
  11585.   my $val= "a1";
  11586.   my $exp= qq{//p[ \@att='$val']}; # you need to use \@ or you will get a warning
  11587.   my @res= $t->get_xpath( $exp);
  11588.  
  11589. Note that the only supported regexps delimiters are / and that you must 
  11590. backslash all / in regexps AND in regular strings.
  11591.  
  11592. XML::Twig does not provide natively full XPATH support, but you can use 
  11593. C<L<XML::Twig::XPath>> to get C<findnodes> to use C<XML::XPath> as the
  11594. XPath engine, with full coverage of the spec.
  11595.  
  11596. C<L<XML::Twig::XPath>> to get C<findnodes> to use C<XML::XPath> as the
  11597. XPath engine, with full coverage of the spec.
  11598.  
  11599. =item find_nodes
  11600.  
  11601. same asC<get_xpath> 
  11602.  
  11603. =item findnodes
  11604.  
  11605. same as C<get_xpath> 
  11606.  
  11607.  
  11608. =item text @optional_options
  11609.  
  11610. Return a string consisting of all the C<PCDATA> and C<CDATA> in an element, 
  11611. without any tags. The text is not XML-escaped: base entities such as C<&> 
  11612. and C<< < >> are not escaped.
  11613.  
  11614. The 'C<no_recurse>' option will only return the text of the element, not
  11615. of any included sub-elements (same as C<L<text_only>>).
  11616.  
  11617. =item text_only
  11618.  
  11619. Same as C<L<text>> except that the text returned doesn't include 
  11620. the text of sub-elements.
  11621.  
  11622. =item trimmed_text
  11623.  
  11624. Same as C<text> except that the text is trimmed: leading and trailing spaces
  11625. are discarded, consecutive spaces are collapsed
  11626.  
  11627. =item set_text        ($string)
  11628.  
  11629. Set the text for the element: if the element is a C<PCDATA>, just set its
  11630. text, otherwise cut all the children of the element and create a single
  11631. C<PCDATA> child for it, which holds the text.
  11632.  
  11633. =item merge ($elt2)
  11634.  
  11635. Move the content of C<$elt2> within the element
  11636.  
  11637. =item insert         ($tag1, [$optional_atts1], $tag2, [$optional_atts2],...)
  11638.  
  11639. For each tag in the list inserts an element C<$tag> as the only child of the 
  11640. element.  The element gets the optional attributes inC<< $optional_atts<n>. >> 
  11641. All children of the element are set as children of the new element.
  11642. The upper level element is returned.
  11643.  
  11644.   $p->insert( table => { border=> 1}, 'tr', 'td') 
  11645.  
  11646. put C<$p> in a table with a visible border, a single C<tr> and a single C<td> 
  11647. and return the C<table> element:
  11648.  
  11649.   <p><table border="1"><tr><td>original content of p</td></tr></table></p>
  11650.  
  11651. =item wrap_in        (@tag)
  11652.  
  11653. Wrap elements in C<@tag> as the successive ancestors of the element, returns the 
  11654. new element.
  11655. C<< $elt->wrap_in( 'td', 'tr', 'table') >> wraps the element as a single cell in a 
  11656. table for example.
  11657.  
  11658. Optionally each tag can be followed by a hashref of attributes, that will be 
  11659. set on the wrapping element:
  11660.  
  11661.   $elt->wrap_in( p => { class => "advisory" }, div => { class => "intro", id => "div_intro });
  11662.  
  11663. =item insert_new_elt ($opt_position, $tag, $opt_atts_hashref, @opt_content)
  11664.  
  11665. Combines a C<L<new|new> > and a C<L<paste|paste> >: creates a new element using 
  11666. C<$tag>, C<$opt_atts_hashref >and C<@opt_content> which are arguments similar 
  11667. to those for C<new>, then paste it, using C<$opt_position> or C<'first_child'>,
  11668. relative to C<$elt>.
  11669.  
  11670. Return the newly created element
  11671.  
  11672. =item erase
  11673.  
  11674. Erase the element: the element is deleted and all of its children are
  11675. pasted in its place.
  11676.  
  11677. =item set_content    ( $optional_atts, @list_of_elt_and_strings)
  11678.                      ( $optional_atts, '#EMPTY')
  11679.  
  11680. Set the content for the element, from a list of strings and
  11681. elements.  Cuts all the element children, then pastes the list
  11682. elements as the children.  This method will create a C<PCDATA> element
  11683. for any strings in the list.
  11684.  
  11685. The C<$optional_atts> argument is the ref of a hash of attributes. If this
  11686. argument is used then the previous attributes are deleted, otherwise they
  11687. are left untouched. 
  11688.  
  11689. B<WARNING>: if you rely on ID's then you will have to set the id yourself. At
  11690. this point the element does not belong to a twig yet, so the ID attribute
  11691. is not known so it won't be stored in the ID list.
  11692.  
  11693. A content of 'C<#EMPTY>' creates an empty element;
  11694.  
  11695. =item namespace ($optional_prefix)
  11696.  
  11697. Return the URI of the namespace that C<$optional_prefix> or the element name
  11698. belongs to. If the name doesn't belong to any namespace, C<undef> is returned.
  11699.  
  11700. =item local_name
  11701.  
  11702. Return the local name (without the prefix) for the element
  11703.  
  11704. =item ns_prefix
  11705.  
  11706. Return the namespace prefix for the element
  11707.  
  11708. =item current_ns_prefixes
  11709.  
  11710. Return a list of namespace prefixes valid for the element. The order of the
  11711. prefixes in the list has no meaning. If the default namespace is currently 
  11712. bound, '' appears in the list.
  11713.  
  11714.  
  11715. =item inherit_att  ($att, @optional_tag_list)
  11716.  
  11717. Return the value of an attribute inherited from parent tags. The value
  11718. returned is found by looking for the attribute in the element then in turn
  11719. in each of its ancestors. If the C<@optional_tag_list> is supplied only those
  11720. ancestors whose tag is in the list will be checked. 
  11721.  
  11722. =item all_children_are ($optional_condition)
  11723.  
  11724. return 1 if all children of the element pass the C<$optional_condition>, 
  11725. 0 otherwise
  11726.  
  11727. =item level       ($optional_condition)
  11728.  
  11729. Return the depth of the element in the twig (root is 0).
  11730. If C<$optional_condition> is given then only ancestors that match the condition are 
  11731. counted.
  11732.  
  11733. B<WARNING>: in a tree created using the C<twig_roots> option this will not return
  11734. the level in the document tree, level 0 will be the document root, level 1 
  11735. will be the C<twig_roots> elements. During the parsing (in a C<twig_handler>)
  11736. you can use the C<depth> method on the twig object to get the real parsing depth.
  11737.  
  11738. =item in           ($potential_parent)
  11739.  
  11740. Return true if the element is in the potential_parent (C<$potential_parent> is 
  11741. an element)
  11742.  
  11743. =item in_context   ($cond, $optional_level)
  11744.  
  11745. Return true if the element is included in an element which passes C<$cond>
  11746. optionally within C<$optional_level> levels. The returned value is the 
  11747. including element.
  11748.  
  11749. =item pcdata
  11750.  
  11751. Return the text of a C<PCDATA> element or C<undef> if the element is not 
  11752. C<PCDATA>.
  11753.  
  11754. =item pcdata_xml_string
  11755.  
  11756. Return the text of a PCDATA element or undef if the element is not PCDATA. 
  11757. The text is "XML-escaped" ('&' and '<' are replaced by '&' and '<')
  11758.  
  11759. =item set_pcdata     ($text)
  11760.  
  11761. Set the text of a C<PCDATA> element. 
  11762.  
  11763. =item append_pcdata  ($text)
  11764.  
  11765. Add the text at the end of a C<PCDATA> element.
  11766.  
  11767. =item is_cdata
  11768.  
  11769. Return 1 if the element is a C<CDATA> element, returns 0 otherwise.
  11770.  
  11771. =item is_text
  11772.  
  11773. Return 1 if the element is a C<CDATA> or C<PCDATA> element, returns 0 otherwise.
  11774.  
  11775. =item cdata
  11776.  
  11777. Return the text of a C<CDATA> element or C<undef> if the element is not 
  11778. C<CDATA>.
  11779.  
  11780. =item cdata_string
  11781.  
  11782. Return the XML string of a C<CDATA> element, including the opening and
  11783. closing markers.
  11784.  
  11785. =item set_cdata     ($text)
  11786.  
  11787. Set the text of a C<CDATA> element. 
  11788.  
  11789. =item append_cdata  ($text)
  11790.  
  11791. Add the text at the end of a C<CDATA> element.
  11792.  
  11793. =item remove_cdata
  11794.  
  11795. Turns all C<CDATA> sections in the element into regular C<PCDATA> elements. This is useful
  11796. when converting XML to HTML, as browsers do not support CDATA sections. 
  11797.  
  11798. =item extra_data 
  11799.  
  11800. Return the extra_data (comments and PI's) attached to an element
  11801.  
  11802. =item set_extra_data     ($extra_data)
  11803.  
  11804. Set the extra_data (comments and PI's) attached to an element
  11805.  
  11806. =item append_extra_data  ($extra_data)
  11807.  
  11808. Append extra_data to the existing extra_data before the element (if no
  11809. previous extra_data exists then it is created)
  11810.  
  11811. =item set_asis
  11812.  
  11813. Set a property of the element that causes it to be output without being XML
  11814. escaped by the print functions: if it contains C<< a < b >> it will be output
  11815. as such and not as C<< a < b >>. This can be useful to create text elements
  11816. that will be output as markup. Note that all C<PCDATA> descendants of the 
  11817. element are also marked as having the property (they are the ones that are
  11818. actually impacted by the change).
  11819.  
  11820. If the element is a C<CDATA> element it will also be output asis, without the
  11821. C<CDATA> markers. The same goes for any C<CDATA> descendant of the element
  11822.  
  11823. =item set_not_asis
  11824.  
  11825. Unsets the C<asis> property for the element and its text descendants.
  11826.  
  11827. =item is_asis
  11828.  
  11829. Return the C<asis> property status of the element ( 1 or C<undef>)
  11830.  
  11831. =item closed                   
  11832.  
  11833. Return true if the element has been closed. Might be useful if you are
  11834. somewhere in the tree, during the parse, and have no idea whether a parent
  11835. element is completely loaded or not.
  11836.  
  11837. =item get_type
  11838.  
  11839. Return the type of the element: 'C<#ELT>' for "real" elements, or 'C<#PCDATA>',
  11840. 'C<#CDATA>', 'C<#COMMENT>', 'C<#ENT>', 'C<#PI>'
  11841.  
  11842. =item is_elt
  11843.  
  11844. Return the tag if the element is a "real" element, or 0 if it is C<PCDATA>, 
  11845. C<CDATA>...
  11846.  
  11847. =item contains_only_text
  11848.  
  11849. Return 1 if the element does not contain any other "real" element
  11850.  
  11851. =item contains_only ($exp)
  11852.  
  11853. Return the list of children if all children of the element match
  11854. the expression C<$exp> 
  11855.  
  11856.   if( $para->contains_only( 'tt')) { ... }
  11857.  
  11858. =item contains_a_single ($exp)
  11859.  
  11860. If the element contains a single child that matches the expression C<$exp>
  11861. returns that element. Otherwise returns 0.
  11862.  
  11863. =item is_field
  11864.  
  11865. same as C<contains_only_text> 
  11866.  
  11867. =item is_pcdata
  11868.  
  11869. Return 1 if the element is a C<PCDATA> element, returns 0 otherwise.
  11870.  
  11871. =item is_ent
  11872.  
  11873. Return 1 if the element is an entity (an unexpanded entity) element, 
  11874. return 0 otherwise.
  11875.  
  11876. =item is_empty
  11877.  
  11878. Return 1 if the element is empty, 0 otherwise
  11879.  
  11880. =item set_empty
  11881.  
  11882. Flags the element as empty. No further check is made, so if the element
  11883. is actually not empty the output will be messed. The only effect of this 
  11884. method is that the output will be C<< <tag att="value""/> >>.
  11885.  
  11886. =item set_not_empty
  11887.  
  11888. Flags the element as not empty. if it is actually empty then the element will
  11889. be output as C<< <tag att="value""></tag> >>
  11890.  
  11891. =item is_pi
  11892.  
  11893. Return 1 if the element is a processing instruction (C<#PI>) element,
  11894. return 0 otherwise.
  11895.  
  11896. =item target
  11897.  
  11898. Return the target of a processing instruction
  11899.  
  11900. =item set_target ($target)
  11901.  
  11902. Set the target of a processing instruction
  11903.  
  11904. =item data
  11905.  
  11906. Return the data part of a processing instruction
  11907.  
  11908. =item set_data ($data)
  11909.  
  11910. Set the data of a processing instruction
  11911.  
  11912. =item set_pi ($target, $data)
  11913.  
  11914. Set the target and data of a processing instruction
  11915.  
  11916. =item pi_string
  11917.  
  11918. Return the string form of a processing instruction
  11919. (C<< <?target data?> >>)
  11920.  
  11921. =item is_comment
  11922.  
  11923. Return 1 if the element is a comment (C<#COMMENT>) element,
  11924. return 0 otherwise.
  11925.  
  11926. =item set_comment ($comment_text)
  11927.  
  11928. Set the text for a comment
  11929.  
  11930. =item comment
  11931.  
  11932. Return the content of a comment (just the text, not the C<< <!-- >>
  11933. and C<< --> >>)
  11934.  
  11935. =item comment_string 
  11936.  
  11937. Return the XML string for a comment (C<< <!-- comment --> >>)
  11938.  
  11939. =item set_ent ($entity)
  11940.  
  11941. Set an (non-expanded) entity (C<#ENT>). C<$entity>) is the entity
  11942. text (C<&ent;>)
  11943.  
  11944. =item ent
  11945.  
  11946. Return the entity for an entity (C<#ENT>) element (C<&ent;>)
  11947.  
  11948. =item ent_name
  11949.  
  11950. Return the entity name for an entity (C<#ENT>) element (C<ent>)
  11951.  
  11952. =item ent_string
  11953.  
  11954. Return the entity, either expanded if the expanded version is available,
  11955. or non-expanded (C<&ent;>) otherwise
  11956.  
  11957. =item child ($offset, $optional_condition)
  11958.  
  11959. Return the C<$offset>-th child of the element, optionally the C<$offset>-th 
  11960. child that matches C<$optional_condition>. The children are treated as a list, so 
  11961. C<< $elt->child( 0) >> is the first child, while C<< $elt->child( -1) >> is 
  11962. the last child.
  11963.  
  11964. =item child_text ($offset, $optional_condition)
  11965.  
  11966. Return the text of a child or C<undef> if the sibling does not exist. Arguments
  11967. are the same as child.
  11968.  
  11969. =item last_child    ($optional_condition)
  11970.  
  11971. Return the last child of the element, or the last child matching 
  11972. C<$optional_condition> (ie the last of the element children matching
  11973. the condition).
  11974.  
  11975. =item last_child_text   ($optional_condition)
  11976.  
  11977. Same as C<first_child_text> but for the last child.
  11978.  
  11979. =item sibling  ($offset, $optional_condition)
  11980.  
  11981. Return the next or previous C<$offset>-th sibling of the element, or the 
  11982. C<$offset>-th one matching C<$optional_condition>. If C<$offset> is negative then a 
  11983. previous sibling is returned, if $offset is positive then  a next sibling is 
  11984. returned. C<$offset=0> returns the element if there is no condition or
  11985. if the element matches the condition>, C<undef> otherwise.
  11986.  
  11987. =item sibling_text ($offset, $optional_condition)
  11988.  
  11989. Return the text of a sibling or C<undef> if the sibling does not exist. 
  11990. Arguments are the same as C<sibling>.
  11991.  
  11992. =item prev_siblings ($optional_condition)
  11993.  
  11994. Return the list of previous siblings (optionally matching C<$optional_condition>)
  11995. for the element. The elements are ordered in document order.
  11996.  
  11997. =item next_siblings ($optional_condition)
  11998.  
  11999. Return the list of siblings (optionally matching C<$optional_condition>)
  12000. following the element. The elements are ordered in document order.
  12001.  
  12002. =item pos ($optional_condition)
  12003.  
  12004. Return the position of the element in the children list. The first child has a
  12005. position of 1 (as in XPath).
  12006.  
  12007. If the C<$optional_condition> is given then only siblings that match the condition 
  12008. are counted. If the element itself does not match the  condition then
  12009. 0 is returned.
  12010.  
  12011. =item atts
  12012.  
  12013. Return a hash ref containing the element attributes
  12014.  
  12015. =item set_atts      ({att1=>$att1_val, att2=> $att2_val... })
  12016.  
  12017. Set the element attributes with the hash ref supplied as the argument
  12018.  
  12019. =item del_atts
  12020.  
  12021. Deletes all the element attributes.
  12022.  
  12023. =item att_nb
  12024.  
  12025. Return the number of attributes for the element
  12026.  
  12027. =item has_atts
  12028.  
  12029. Return true if the element has attributes (in fact return the number of
  12030. attributes, thus being an alias to C<L<att_nb>>
  12031.  
  12032. =item has_no_atts
  12033.  
  12034. Return true if the element has no attributes, false (0) otherwise
  12035.  
  12036. =item att_names
  12037.  
  12038. return a list of the attribute names for the element
  12039.  
  12040. =item att_xml_string ($att, $optional_quote)
  12041.  
  12042. Return the attribute value, where '&', '<' and $quote (" by default)
  12043. are XML-escaped
  12044.  
  12045. if C<$optional_quote> is passed then it is used as the quote.
  12046.  
  12047. =item set_id       ($id)
  12048.  
  12049. Set the C<id> attribute of the element to the value.
  12050. See C<L<elt_id|elt_id> > to change the id attribute name
  12051.  
  12052. =item id
  12053.  
  12054. Gets the id attribute value
  12055.  
  12056. =item del_id       ($id)
  12057.  
  12058. Deletes the C<id> attribute of the element and remove it from the id list
  12059. for the document
  12060.  
  12061. =item class
  12062.  
  12063. Return the C<class> attribute for the element (methods on the C<class>
  12064. attribute are quite convenient when dealing with XHTML, or plain XML that
  12065. will eventually be displayed using CSS)
  12066.  
  12067. =item set_class ($class)
  12068.  
  12069. Set the C<class> attribute for the element to C<$class>
  12070.  
  12071. =item add_to_class ($class)
  12072.  
  12073. Add C<$class> to the element C<class> attribute: the new class is added
  12074. only if it is not already present. Note that classes are sorted alphabetically,
  12075. so the C<class> attribute can be changed even if the class is already there
  12076.  
  12077. =item att_to_class ($att)
  12078.  
  12079. Set the C<class> attribute to the value of attribute C<$att>
  12080.  
  12081. =item add_att_to_class ($att)
  12082.  
  12083. Add the value of attribute C<$att> to the C<class> attribute of the element
  12084.  
  12085. =item move_att_to_class ($att)
  12086.  
  12087. Add the value of attribute C<$att> to the C<class> attribute of the element
  12088. and delete the attribute
  12089.  
  12090. =item tag_to_class
  12091.  
  12092. Set the C<class> attribute of the element to the element tag
  12093.  
  12094. =item add_tag_to_class
  12095.  
  12096. Add the element tag to its C<class> attribute
  12097.  
  12098. =item set_tag_class ($new_tag)
  12099.  
  12100. Add the element tag to its C<class> attribute and sets the tag to C<$new_tag>
  12101.  
  12102. =item in_class ($class)
  12103.  
  12104. Return true (C<1>) if the element is in the class C<$class> (if C<$class> is
  12105. one of the tokens in the element C<class> attribute)
  12106.  
  12107. =item tag_to_span
  12108.  
  12109. Change the element tag tp C<span> and set its class to the old tag
  12110.  
  12111. =item tag_to_div
  12112.  
  12113. Change the element tag tp C<div> and set its class to the old tag
  12114.  
  12115. =item DESTROY
  12116.  
  12117. Frees the element from memory.
  12118.  
  12119. =item start_tag
  12120.  
  12121. Return the string for the start tag for the element, including 
  12122. the C<< /> >> at the end of an empty element tag
  12123.  
  12124. =item end_tag
  12125.  
  12126. Return the string for the end tag of an element.  For an empty
  12127. element, this returns the empty string ('').
  12128.  
  12129. =item xml_string @optional_options
  12130.  
  12131. Equivalent to C<< $elt->sprint( 1) >>, returns the string for the entire 
  12132. element, excluding the element's tags (but nested element tags are present)
  12133.  
  12134. The 'C<no_recurse>' option will only return the text of the element, not
  12135. of any included sub-elements (same as C<L<xml_text_only>>).
  12136.  
  12137. =item inner_xml
  12138.  
  12139. Another synonym for xml_string
  12140.  
  12141. =item outer_xml
  12142.  
  12143. An other synonym for sprint
  12144.  
  12145. =item xml_text 
  12146.  
  12147. Return the text of the element, encoded (and processed by the current 
  12148. C<L<output_filter>> or C<L<output_encoding>> options, without any tag.
  12149.  
  12150. =item xml_text_only
  12151.  
  12152. Same as C<L<xml_text>> except that the text returned doesn't include 
  12153. the text of sub-elements.
  12154.  
  12155. =item set_pretty_print ($style)
  12156.  
  12157. Set the pretty print method, amongst 'C<none>' (default), 'C<nsgmls>', 
  12158. 'C<nice>', 'C<indented>', 'C<record>' and 'C<record_c>'
  12159.  
  12160. pretty_print styles:
  12161.  
  12162. =over 4
  12163.  
  12164. =item none
  12165.  
  12166. the default, no C<\n> is used
  12167.  
  12168. =item nsgmls
  12169.  
  12170. nsgmls style, with C<\n> added within tags
  12171.  
  12172. =item nice
  12173.  
  12174. adds C<\n> wherever possible (NOT SAFE, can lead to invalid XML)
  12175.  
  12176. =item indented
  12177.  
  12178. same as C<nice> plus indents elements (NOT SAFE, can lead to invalid XML) 
  12179.  
  12180. =item record
  12181.  
  12182. table-oriented pretty print, one field per line 
  12183.  
  12184. =item record_c
  12185.  
  12186. table-oriented pretty print, more compact than C<record>, one record per line 
  12187.  
  12188. =back
  12189.  
  12190. =item set_empty_tag_style ($style)
  12191.  
  12192. Set the method to output empty tags, amongst 'C<normal>' (default), 'C<html>',
  12193. and 'C<expand>', 
  12194.  
  12195. C<normal> outputs an empty tag 'C<< <tag/> >>', C<html> adds a space 
  12196. 'C<< <tag /> >>' for elements that can be empty in XHTML and C<expand> outputs
  12197. 'C<< <tag></tag> >>'
  12198.  
  12199. =item set_remove_cdata  ($flag)
  12200.  
  12201. set (or unset) the flag that forces the twig to output CDATA sections as 
  12202. regular (escaped) PCDATA
  12203.  
  12204.  
  12205. =item set_indent ($string)
  12206.  
  12207. Set the indentation for the indented pretty print style (default is 2 spaces)
  12208.  
  12209. =item set_quote ($quote)
  12210.  
  12211. Set the quotes used for attributes. can be 'C<double>' (default) or 'C<single>'
  12212.  
  12213. =item cmp       ($elt)
  12214.  
  12215.   Compare the order of the 2 elements in a twig.
  12216.  
  12217.   C<$a> is the <A>..</A> element, C<$b> is the <B>...</B> element
  12218.   
  12219.   document                        $a->cmp( $b)
  12220.   <A> ... </A> ... <B>  ... </B>     -1
  12221.   <A> ... <B>  ... </B> ... </A>     -1
  12222.   <B> ... </B> ... <A>  ... </A>      1
  12223.   <B> ... <A>  ... </A> ... </B>      1
  12224.    $a == $b                           0
  12225.    $a and $b not in the same tree   undef
  12226.  
  12227. =item before       ($elt)
  12228.  
  12229. Return 1 if C<$elt> starts before the element, 0 otherwise. If the 2 elements 
  12230. are not in the same twig then return C<undef>.
  12231.  
  12232.     if( $a->cmp( $b) == -1) { return 1; } else { return 0; }
  12233.  
  12234. =item after       ($elt)
  12235.  
  12236. Return 1 if $elt starts after the element, 0 otherwise. If the 2 elements 
  12237. are not in the same twig then return C<undef>.
  12238.  
  12239.     if( $a->cmp( $b) == -1) { return 1; } else { return 0; }
  12240.  
  12241. =item other comparison methods
  12242.  
  12243. =over 4
  12244.  
  12245. =item lt
  12246.  
  12247. =item le
  12248.  
  12249. =item gt
  12250.  
  12251. =item ge
  12252.  
  12253. =back
  12254.  
  12255. =item path
  12256.  
  12257. Return the element context in a form similar to XPath's short
  12258. form: 'C</root/tag1/../tag>'
  12259.  
  12260. =item xpath
  12261.  
  12262. Return a unique XPath expression that can be used to find the element
  12263. again. 
  12264.  
  12265. It looks like C</doc/sect[3]/title>: unique elements do not have an index,
  12266. the others do.
  12267.  
  12268. =item private methods
  12269.  
  12270. Low-level methods on the twig:
  12271.  
  12272. =over 4
  12273.  
  12274. =item set_parent        ($parent)
  12275.  
  12276. =item set_first_child   ($first_child)
  12277.  
  12278. =item set_last_child    ($last_child)
  12279.  
  12280. =item set_prev_sibling  ($prev_sibling)
  12281.  
  12282. =item set_next_sibling  ($next_sibling)
  12283.  
  12284. =item set_twig_current
  12285.  
  12286. =item del_twig_current
  12287.  
  12288. =item twig_current
  12289.  
  12290. =item flush
  12291.  
  12292. This method should NOT be used, always flush the twig, not an element.
  12293.  
  12294. =item contains_text
  12295.  
  12296. =back
  12297.  
  12298. Those methods should not be used, unless of course you find some creative 
  12299. and interesting, not to mention useful, ways to do it.
  12300.  
  12301. =back
  12302.  
  12303. =head2 cond
  12304.  
  12305. Most of the navigation functions accept a condition as an optional argument
  12306. The first element (or all elements for C<L<children|children> > or 
  12307. C<L<ancestors|ancestors> >) that passes the condition is returned.
  12308.  
  12309. The condition is a single step of an XPath expression using the XPath subset
  12310. defined by C<L<get_xpath>>. Additional conditions are:
  12311.  
  12312. The condition can be 
  12313.  
  12314. =over 4
  12315.  
  12316. =item #ELT
  12317.  
  12318. return a "real" element (not a PCDATA, CDATA, comment or pi element) 
  12319.  
  12320. =item #TEXT
  12321.  
  12322. return a PCDATA or CDATA element
  12323.  
  12324. =item regular expression
  12325.  
  12326. return an element whose tag matches the regexp. The regexp has to be created 
  12327. with C<qr//> (hence this is available only on perl 5.005 and above)
  12328.  
  12329. =item code reference
  12330.  
  12331. applies the code, passing the current element as argument, if the code returns
  12332. true then the element is returned, if it returns false then the code is applied
  12333. to the next candidate.
  12334.  
  12335. =back
  12336.  
  12337. =head2 XML::Twig::XPath
  12338.  
  12339. XML::Twig implements a subset of XPath through the C<L<get_xpath>> method. 
  12340.  
  12341. If you want to use the whole XPath power, then you can use C<XML::Twig::XPath>
  12342. instead. In this case C<XML::Twig> uses C<XML::XPath> to execute XPath queries.
  12343. You will of course need C<XML::XPath> installed to be able to use C<XML::Twig::XPath>.
  12344.  
  12345. See L<XML::XPath> for more information.
  12346.  
  12347. The methods you can use are:
  12348.  
  12349. =over 4
  12350.  
  12351. =item findnodes              ($path)
  12352.  
  12353. return a list of nodes found by C<$path>.
  12354.  
  12355. =item findnodes_as_string    ($path)
  12356.  
  12357. return the nodes found reproduced as XML. The result is not guaranteed
  12358. to be valid XML though.
  12359.  
  12360. =item findvalue              ($path)
  12361.  
  12362. return the concatenation of the text content of the result nodes
  12363.  
  12364. =back
  12365.  
  12366. In order for C<XML::XPath> to be used as the XPath engine the following methods
  12367. are included in C<XML::Twig>:
  12368.  
  12369. in XML::Twig
  12370.  
  12371. =over 4
  12372.  
  12373. =item getRootNode
  12374.  
  12375. =item getParentNode
  12376.  
  12377. =item getChildNodes 
  12378.  
  12379. =back
  12380.  
  12381. in XML::Twig::Elt
  12382.  
  12383. =over 4
  12384.  
  12385. =item string_value
  12386.  
  12387. =item toString
  12388.  
  12389. =item getName
  12390.  
  12391. =item getRootNode
  12392.  
  12393. =item getNextSibling
  12394.  
  12395. =item getPreviousSibling
  12396.  
  12397. =item isElementNode
  12398.  
  12399. =item isTextNode
  12400.  
  12401. =item isPI
  12402.  
  12403. =item isPINode
  12404.  
  12405. =item isProcessingInstructionNode
  12406.  
  12407. =item isComment
  12408.  
  12409. =item isCommentNode
  12410.  
  12411. =item getTarget 
  12412.  
  12413. =item getChildNodes 
  12414.  
  12415. =item getElementById
  12416.  
  12417. =back
  12418.  
  12419. =head2 XML::Twig::XPath::Elt
  12420.  
  12421. The methods you can use are the same as on C<XML::Twig::XPath> elements:
  12422.  
  12423. =over 4
  12424.  
  12425. =item findnodes              ($path)
  12426.  
  12427. return a list of nodes found by C<$path>.
  12428.  
  12429. =item findnodes_as_string    ($path)
  12430.  
  12431. return the nodes found reproduced as XML. The result is not guaranteed
  12432. to be valid XML though.
  12433.  
  12434. =item findvalue              ($path)
  12435.  
  12436. return the concatenation of the text content of the result nodes
  12437.  
  12438. =back
  12439.  
  12440.  
  12441. =head2 XML::Twig::Entity_list
  12442.  
  12443. =over 4
  12444.  
  12445. =item new
  12446.  
  12447. Create an entity list.
  12448.  
  12449. =item add         ($ent)
  12450.  
  12451. Add an entity to an entity list.
  12452.  
  12453. =item add_new_ent ($name, $val, $sysid, $pubid, $ndata, $param)
  12454.  
  12455. Create a new entity and add it to the entity list
  12456.  
  12457. =item delete     ($ent or $tag).
  12458.  
  12459. Delete an entity (defined by its name or by the Entity object)
  12460. from the list.
  12461.  
  12462. =item print      ($optional_filehandle)
  12463.  
  12464. Print the entity list.
  12465.  
  12466. =item list
  12467.  
  12468. Return the list as an array
  12469.  
  12470. =back
  12471.  
  12472.  
  12473. =head2 XML::Twig::Entity
  12474.  
  12475. =over 4
  12476.  
  12477. =item new        ($name, $val, $sysid, $pubid, $ndata, $param)
  12478.  
  12479. Same arguments as the Entity handler for XML::Parser.
  12480.  
  12481. =item print       ($optional_filehandle)
  12482.  
  12483. Print an entity declaration.
  12484.  
  12485. =item name 
  12486.  
  12487. Return the name of the entity
  12488.  
  12489. =item val  
  12490.  
  12491. Return the value of the entity
  12492.  
  12493. =item sysid
  12494.  
  12495. Return the system id for the entity (for NDATA entities)
  12496.  
  12497. =item pubid
  12498.  
  12499. Return the public id for the entity (for NDATA entities)
  12500.  
  12501. =item ndata
  12502.  
  12503. Return true if the entity is an NDATA entity
  12504.  
  12505. =item param
  12506.  
  12507. Return true if the entity is a parameter entity
  12508.  
  12509.  
  12510. =item text
  12511.  
  12512. Return the entity declaration text.
  12513.  
  12514. =back
  12515.  
  12516.  
  12517. =head1 EXAMPLES
  12518.  
  12519. Additional examples (and a complete tutorial) can be found  on the
  12520. F<XML::Twig PageL<http://www.xmltwig.com/xmltwig/>>
  12521.  
  12522. To figure out what flush does call the following script with an
  12523. XML file and an element name as arguments
  12524.  
  12525.   use XML::Twig;
  12526.  
  12527.   my ($file, $elt)= @ARGV;
  12528.   my $t= XML::Twig->new( twig_handlers => 
  12529.       { $elt => sub {$_[0]->flush; print "\n[flushed here]\n";} });
  12530.   $t->parsefile( $file, ErrorContext => 2);
  12531.   $t->flush;
  12532.   print "\n";
  12533.  
  12534.  
  12535. =head1 NOTES
  12536.  
  12537. =head2 Subclassing XML::Twig
  12538.  
  12539. Useful methods:
  12540.  
  12541. =over 4
  12542.  
  12543. =item elt_class
  12544.  
  12545. In order to subclass C<XML::Twig> you will probably need to subclass also
  12546. C<L<XML::Twig::Elt>>. Use the C<elt_class> option when you create the
  12547. C<XML::Twig> object to get the elements created in a different class
  12548. (which should be a subclass of C<XML::Twig::Elt>.
  12549.  
  12550. =item add_options
  12551.  
  12552. If you inherit C<XML::Twig> new method but want to add more options to it
  12553. you can use this method to prevent XML::Twig to issue warnings for those
  12554. additional options.
  12555.  
  12556. =back
  12557.  
  12558. =head2 DTD Handling
  12559.  
  12560. There are 3 possibilities here.  They are:
  12561.  
  12562. =over 4
  12563.  
  12564. =item No DTD
  12565.  
  12566. No doctype, no DTD information, no entity information, the world is simple...
  12567.  
  12568. =item Internal DTD
  12569.  
  12570. The XML document includes an internal DTD, and maybe entity declarations.
  12571.  
  12572. If you use the load_DTD option when creating the twig the DTD information and
  12573. the entity declarations can be accessed.
  12574.  
  12575. The DTD and the entity declarations will be C<flush>'ed (or C<print>'ed) either
  12576. as is (if they have not been modified) or as reconstructed (poorly, comments 
  12577. are lost, order is not kept, due to it's content this DTD should not be viewed 
  12578. by anyone) if they have been modified. You can also modify them directly by 
  12579. changing the C<< $twig->{twig_doctype}->{internal} >> field (straight from 
  12580. XML::Parser, see the C<Doctype> handler doc)
  12581.  
  12582. =item External DTD
  12583.  
  12584. The XML document includes a reference to an external DTD, and maybe entity 
  12585. declarations.
  12586.  
  12587. If you use the C<load_DTD> when creating the twig the DTD information and the 
  12588. entity declarations can be accessed. The entity declarations will be
  12589. C<flush>'ed (or C<print>'ed) either as is (if they have not been modified) or
  12590. as reconstructed (badly, comments are lost, order is not kept).
  12591.  
  12592. You can change the doctype through the C<< $twig->set_doctype >> method and 
  12593. print the dtd through the C<< $twig->dtd_text >> or C<< $twig->dtd_print >>
  12594.  methods.
  12595.  
  12596. If you need to modify the entity list this is probably the easiest way to do it.
  12597.  
  12598. =back
  12599.  
  12600.  
  12601. =head2 Flush
  12602.  
  12603. If you set handlers and use C<flush>, do not forget to flush the twig one
  12604. last time AFTER the parsing, or you might be missing the end of the document.
  12605.  
  12606. Remember that element handlers are called when the element is CLOSED, so
  12607. if you have handlers for nested elements the inner handlers will be called
  12608. first. It makes it for example trickier than it would seem to number nested
  12609. clauses.
  12610.  
  12611.  
  12612.  
  12613. =head1 BUGS
  12614.  
  12615. =over 4
  12616.  
  12617. =item entity handling
  12618.  
  12619. Due to XML::Parser behaviour, non-base entities in attribute values disappear:
  12620. C<att="val&ent;"> will be turned into C<< att => val >>, unless you use the 
  12621. C<keep_encoding> argument to C<< XML::Twig->new >> 
  12622.  
  12623. =item DTD handling
  12624.  
  12625. The DTD handling methods are quite bugged. No one uses them and
  12626. it seems very difficult to get them to work in all cases, including with 
  12627. several slightly incompatible versions of XML::Parser and of libexpat.
  12628.  
  12629. Basically you can read the DTD, output it back properly, and update entities,
  12630. but not much more.
  12631.  
  12632. So use XML::Twig with standalone documents, or with documents refering to an
  12633. external DTD, but don't expect it to properly parse and even output back the
  12634. DTD.
  12635.  
  12636. =item memory leak
  12637.  
  12638. If you use a lot of twigs you might find that you leak quite a lot of memory
  12639. (about 2Ks per twig). You can use the C<L<dispose|dispose> > method to free 
  12640. that memory after you are done.
  12641.  
  12642. If you create elements the same thing might happen, use the C<L<delete|delete>>
  12643. method to get rid of them.
  12644.  
  12645. Alternatively installing the C<Scalar::Util> (or C<WeakRef>) module on a version 
  12646. of Perl that supports it (>5.6.0) will get rid of the memory leaks automagically.
  12647.  
  12648. =item ID list
  12649.  
  12650. The ID list is NOT updated when elements are cut or deleted.
  12651.  
  12652. =item change_gi
  12653.  
  12654. This method will not function properly if you do:
  12655.  
  12656.      $twig->change_gi( $old1, $new);
  12657.      $twig->change_gi( $old2, $new);
  12658.      $twig->change_gi( $new, $even_newer);
  12659.  
  12660. =item sanity check on XML::Parser method calls
  12661.  
  12662. XML::Twig should really prevent calls to some XML::Parser methods, especially 
  12663. the C<setHandlers> method.
  12664.  
  12665. =item pretty printing
  12666.  
  12667. Pretty printing (at least using the 'C<indented>' style) is hard to get right! 
  12668. Only elements that belong to the document will be properly indented. Printing 
  12669. elements that do not belong to the twig makes it impossible for XML::Twig to 
  12670. figure out their depth, and thus their indentation level.
  12671.  
  12672. Also there is an unavoidable bug when using C<flush> and pretty printing for
  12673. elements with mixed content that start with an embedded element:
  12674.  
  12675.   <elt><b>b</b>toto<b>bold</b></elt>
  12676.  
  12677.   will be output as 
  12678.  
  12679.   <elt>
  12680.     <b>b</b>toto<b>bold</b></elt>
  12681.  
  12682. if you flush the twig when you find the C<< <b> >> element
  12683.   
  12684.  
  12685. =back
  12686.  
  12687. =head1 Globals
  12688.  
  12689. These are the things that can mess up calling code, especially if threaded.
  12690. They might also cause problem under mod_perl. 
  12691.  
  12692. =over 4
  12693.  
  12694. =item Exported constants
  12695.  
  12696. Whether you want them or not you get them! These are subroutines to use
  12697. as constant when creating or testing elements
  12698.  
  12699.   PCDATA  return '#PCDATA'
  12700.   CDATA   return '#CDATA'
  12701.   PI      return '#PI', I had the choice between PROC and PI :--(
  12702.  
  12703. =item Module scoped values: constants
  12704.  
  12705. these should cause no trouble:
  12706.  
  12707.   %base_ent= ( '>' => '>',
  12708.                '<' => '<',
  12709.                '&' => '&',
  12710.                "'" => ''',
  12711.                '"' => '"',
  12712.              );
  12713.   CDATA_START   = "<![CDATA[";
  12714.   CDATA_END     = "]]>";
  12715.   PI_START      = "<?";
  12716.   PI_END        = "?>";
  12717.   COMMENT_START = "<!--";
  12718.   COMMENT_END   = "-->";
  12719.  
  12720. pretty print styles
  12721.  
  12722.   ( $NSGMLS, $NICE, $INDENTED, $INDENTED_C, $WRAPPED, $RECORD1, $RECORD2)= (1..7);
  12723.  
  12724. empty tag output style
  12725.  
  12726.   ( $HTML, $EXPAND)= (1..2);
  12727.  
  12728. =item Module scoped values: might be changed
  12729.  
  12730. Most of these deal with pretty printing, so the worst that can
  12731. happen is probably that XML output does not look right, but is
  12732. still valid and processed identically by XML processors.
  12733.  
  12734. C<$empty_tag_style> can mess up HTML bowsers though and changing C<$ID> 
  12735. would most likely create problems.
  12736.  
  12737.   $pretty=0;           # pretty print style
  12738.   $quote='"';          # quote for attributes
  12739.   $INDENT= '  ';       # indent for indented pretty print
  12740.   $empty_tag_style= 0; # how to display empty tags
  12741.   $ID                  # attribute used as an id ('id' by default)
  12742.  
  12743. =item Module scoped values: definitely changed
  12744.  
  12745. These 2 variables are used to replace tags by an index, thus 
  12746. saving some space when creating a twig. If they really cause
  12747. you too much trouble, let me know, it is probably possible to
  12748. create either a switch or at least a version of XML::Twig that 
  12749. does not perform this optimization.
  12750.  
  12751.   %gi2index;     # tag => index
  12752.   @index2gi;     # list of tags
  12753.  
  12754. =back
  12755.  
  12756. If you need to manipulate all those values, you can use the following methods on the
  12757. XML::Twig object:
  12758.  
  12759. =over 4
  12760.  
  12761. =item global_state
  12762.  
  12763. Return a hashref with all the global variables used by XML::Twig
  12764.  
  12765. The hash has the following fields:  C<pretty>, C<quote>, C<indent>, 
  12766. C<empty_tag_style>, C<keep_encoding>, C<expand_external_entities>, 
  12767. C<output_filter>, C<output_text_filter>, C<keep_atts_order>
  12768.  
  12769. =item set_global_state ($state)
  12770.  
  12771. Set the global state, C<$state> is a hashref
  12772.  
  12773. =item save_global_state
  12774.  
  12775. Save the current global state
  12776.  
  12777. =item restore_global_state
  12778.  
  12779. Restore the previously saved (using C<Lsave_global_state>> state
  12780.  
  12781. =back
  12782.  
  12783. =head1 TODO 
  12784.  
  12785. =over 4
  12786.  
  12787. =item SAX handlers
  12788.  
  12789. Allowing XML::Twig to work on top of any SAX parser
  12790.  
  12791. =item multiple twigs are not well supported
  12792.  
  12793. A number of twig features are just global at the moment. These include
  12794. the ID list and the "tag pool" (if you use C<change_gi> then you change the tag 
  12795. for ALL twigs).
  12796.  
  12797. A future version will try to support this while trying not to be to
  12798. hard on performance (at least when a single twig is used!).
  12799.  
  12800.  
  12801. =back
  12802.  
  12803.  
  12804. =head1 AUTHOR
  12805.  
  12806. Michel Rodriguez <mirod@xmltwig.com>
  12807.  
  12808. =head1 LICENSE
  12809.  
  12810. This library is free software; you can redistribute it and/or modify
  12811. it under the same terms as Perl itself.
  12812.  
  12813. Bug reports should be sent using:
  12814. F<RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=XML-Twig>>
  12815.  
  12816. Comments can be sent to mirod@xmltwig.com
  12817.  
  12818. The XML::Twig page is at L<http://www.xmltwig.com/xmltwig/>
  12819. It includes the development version of the module, a slightly better version 
  12820. of the documentation, examples, a tutorial and a: 
  12821. F<Processing XML efficiently with Perl and XML::Twig: 
  12822. L<http://www.xmltwig.com/xmltwig/tutorial/index.html>>
  12823.  
  12824. =head1 SEE ALSO
  12825.  
  12826. Complete docs, including a tutorial, examples, an easier to use HTML version of
  12827. the docs, a quick reference card and a FAQ are available at 
  12828. L<http://www.xmltwig.com/xmltwig/>
  12829.  
  12830. L<XML::Parser>, L<XML::Parser::Expat>, L<XML::XPath>, L<Encode>, 
  12831. L<Text::Iconv>, L<Scalar::Utils>
  12832.  
  12833.  
  12834. =head2 Alternative Modules
  12835.  
  12836. XML::Twig is not the only XML::Processing module available on CPAN (far from 
  12837. it!).
  12838.  
  12839. The main alternative I would recommend is L<XML::LibXML>. 
  12840.  
  12841. Here is a quick comparison of the 2 modules:
  12842.  
  12843. XML::LibXML, actually C<libxml2> on which it is based, sticks to the standards,
  12844. and implements a good number of them in a rather strict way: XML, XPath, DOM, 
  12845. RelaxNG, I must be forgetting a couple (XInclude?). It is fast and rather 
  12846. frugal memory-wise.
  12847.  
  12848. XML::Twig is older: when I started writing it XML::Parser/expat was the only 
  12849. game in town. It implements XML and that's about it (plus a subset of XPath, 
  12850. and you can use XML::Twig::XPath if you have XML::XPath installed for full 
  12851. support). It is slower and requires more memory for a full tree than 
  12852. XML::LibXML. On the plus side (yes, there is a plus side!) it lets you process
  12853. a big document in chunks, and thus let you tackle documents that couldn't be 
  12854. loaded in memory by XML::LibXML, and it offers a lot (and I mean a LOT!) of 
  12855. higher-level methods, for everything, from adding structure to "low-level" XML,
  12856. to shortcuts for XHTML conversions and more. It also DWIMs quite a bit, getting
  12857. comments and non-significant whitespaces out of the way but preserving them in 
  12858. the output for example. As it does not stick to the DOM, is also usually leads 
  12859. to shorter code than in XML::LibXML.
  12860.  
  12861. Beyond the pure features of the 2 modules, XML::LibXML seems to be prefered by
  12862. "XML-purists", while XML::Twig seems to be more used by Perl Hackers who have 
  12863. to deal with XML. As you have noted, XML::Twig also comes with quite a lot of 
  12864. docs, but I am sure if you ask for help about XML::LibXML here or on Perlmonks
  12865. you will get answers.
  12866.  
  12867. Note that it is actually quite hard for me to compare the 2 modules: on one hand
  12868. I know XML::Twig inside-out and I can get it to do pretty much anything I need 
  12869. to (or I improve it ;--), while I have a very basic knowledge of XML::LibXML. 
  12870. So feature-wise, I'd rather use XML::Twig ;--). On the other hand, I am 
  12871. painfully aware of some of the deficiencies, potential bugs and plain ugly code
  12872. that lurk in XML::Twig, even though you are unlikely to be affected by them 
  12873. (unless for example you need to change the DTD of a document programatically),
  12874. while I haven't looked much into XML::LibXML so it still looks shinny and clean
  12875. to me.
  12876.  
  12877. That said, ifyou need to process a document that is too big to fit memory
  12878. and XML::Twig is too slow for you, my reluctant advice would be to use "bare"
  12879. XML::Parser.  It won't be as easy to use as XML::Twig: basically with XML::Twig
  12880. you trade some speed (depending on what you do from a factor 3 to... none) 
  12881. for ease-of-use, but it will be easier IMHO than using SAX (albeit not 
  12882. standard), and at this point a LOT faster (see the last test in
  12883. L<http://www.xmltwig.com/article/simple_benchmark/>).
  12884.  
  12885. =cut
  12886.  
  12887.  
  12888.